From 933c1d439ef72c9dfc3109e4f1e80662ad17d23c Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant Date: Wed, 13 Sep 2023 23:09:10 +0200 Subject: [PATCH] Import SuperBOL LSP * Move Vscode code into src/vscode (with MIT license) * Import LSP code into src/lsp (with AGPL license) --- .drom | 494 +- .github/workflows/workflow.yml | 27 +- .gitignore | 1 + .gitmodules | 6 + LICENSE.md | 698 ++ Makefile | 2 +- Makefile.header | 4 +- drom.toml | 111 +- dune-project | 236 + emacs/README.md | 8 + emacs/cobol-mode.el | 3139 ++++++ import/gnucobol | 1 + import/merlin | 1 + opam/cobol_ast.opam | 54 + opam/cobol_common.opam | 54 + opam/cobol_config.opam | 56 + opam/cobol_data.opam | 55 + opam/cobol_indent.opam | 55 + opam/cobol_lsp.opam | 62 + opam/cobol_parser.opam | 60 + opam/cobol_preproc.opam | 56 + opam/cobol_typeck.opam | 57 + opam/ebcdic_lib.opam | 52 + opam/ppx_cobcflags.opam | 53 + opam/pretty.opam | 54 + opam/superbol-free.opam | 53 + opam/superbol_free_lib.opam | 60 + scripts/before-sphinx.sh | 3 + sphinx/about.rst | 6 +- sphinx/commands.rst | 204 + sphinx/conf.py | 14 +- sphinx/conf.py.drom-tpl | 223 + sphinx/debug.rst | 177 + sphinx/emacs.rst | 48 + sphinx/index.rst | 3 - sphinx/install-vscode.rst | 38 + sphinx/install.rst | 41 +- sphinx/lsp.rst | 146 + sphinx/platform.rst | 107 + src/lsp/cobol_ast/README.md | 40 + src/lsp/cobol_ast/abstract.ml | 51 + src/lsp/cobol_ast/abstract_visitor.ml | 91 + src/lsp/cobol_ast/ast.ml | 19 + src/lsp/cobol_ast/branching_statements.ml | 458 + src/lsp/cobol_ast/cobol_ast.ml | 31 + src/lsp/cobol_ast/data_descr.ml | 463 + src/lsp/cobol_ast/dune | 26 + src/lsp/cobol_ast/helpers.ml | 36 + src/lsp/cobol_ast/index.mld | 9 + src/lsp/cobol_ast/misc_descr.ml | 412 + src/lsp/cobol_ast/numericals.ml | 62 + src/lsp/cobol_ast/operands.ml | 395 + src/lsp/cobol_ast/operands_visitor.ml | 264 + src/lsp/cobol_ast/package.toml | 75 + src/lsp/cobol_ast/raw.ml | 510 + .../raw_compilation_group_visitor.ml | 213 + .../cobol_ast/raw_data_division_visitor.ml | 62 + .../cobol_ast/raw_data_sections_visitor.ml | 441 + .../cobol_ast/raw_misc_sections_visitor.ml | 236 + .../cobol_ast/raw_proc_division_visitor.ml | 167 + src/lsp/cobol_ast/raw_statements_visitor.ml | 956 ++ src/lsp/cobol_ast/raw_visitor.ml | 19 + src/lsp/cobol_ast/simple_statements.ml | 453 + src/lsp/cobol_ast/terms.ml | 849 ++ src/lsp/cobol_ast/terms_visitor.ml | 435 + src/lsp/cobol_ast/traversal.ml | 896 ++ .../cobol_ast}/version.mlt | 0 src/lsp/cobol_common/README.md | 10 + src/lsp/cobol_common/basics.ml | 130 + src/lsp/cobol_common/behaviors.ml | 21 + src/lsp/cobol_common/cobol_common.ml | 143 + src/lsp/cobol_common/cobol_common.mli | 95 + src/lsp/cobol_common/diagnostics.ml | 269 + src/lsp/cobol_common/diagnostics.mli | 148 + src/lsp/cobol_common/diagnostics_sigs.ml | 70 + src/lsp/cobol_common/dune | 26 + src/lsp/cobol_common/index.mld | 16 + src/lsp/cobol_common/msgs.ml | 52 + src/lsp/cobol_common/package.toml | 75 + src/lsp/cobol_common/srcloc.ml | 652 ++ src/lsp/cobol_common/srcloc.mli | 118 + src/lsp/cobol_common/tokenizing.ml | 31 + src/lsp/cobol_common/tokenizing.mli | 19 + .../cobol_common}/version.mlt | 0 src/lsp/cobol_common/visitor.ml | 219 + src/lsp/cobol_config/README.md | 5 + src/lsp/cobol_config/cobol_config.ml | 278 + src/lsp/cobol_config/cobol_config.mli | 40 + src/lsp/cobol_config/conf_ast.ml | 62 + src/lsp/cobol_config/conf_lexer.mll | 93 + src/lsp/cobol_config/conf_parser.messages | 173 + src/lsp/cobol_config/conf_parser.mly | 111 + src/lsp/cobol_config/default.ml | 311 + src/lsp/cobol_config/default.mli | 15 + src/lsp/cobol_config/dune | 36 + src/lsp/cobol_config/from_file.ml | 224 + src/lsp/cobol_config/from_file.mli | 26 + src/lsp/cobol_config/index.mld | 10 + src/lsp/cobol_config/options.ml | 645 ++ src/lsp/cobol_config/options.mli | 258 + src/lsp/cobol_config/package.toml | 89 + src/lsp/cobol_config/reserved_words.ml | 1676 +++ src/lsp/cobol_config/reserved_words.mli | 25 + src/lsp/cobol_config/types.ml | 502 + .../cobol_config}/version.mlt | 0 src/lsp/cobol_config/words.ml | 154 + src/lsp/cobol_data/README.md | 6 + src/lsp/cobol_data/cobol_data.ml | 33 + src/lsp/cobol_data/compilation_unit.ml | 80 + src/lsp/cobol_data/dune | 26 + src/lsp/cobol_data/env.ml | 112 + src/lsp/cobol_data/group.ml | 448 + src/lsp/cobol_data/group.mli | 45 + src/lsp/cobol_data/index.mld | 10 + src/lsp/cobol_data/mangling.ml | 46 + src/lsp/cobol_data/mangling.mli | 33 + src/lsp/cobol_data/package.toml | 76 + src/lsp/cobol_data/picture.ml | 1151 ++ src/lsp/cobol_data/picture.mli | 213 + src/lsp/cobol_data/pictured_ast.ml | 44 + src/lsp/cobol_data/qualmap.ml | 204 + src/lsp/cobol_data/qualmap.mli | 48 + src/lsp/cobol_data/types.ml | 106 + src/lsp/cobol_data/typing.ml | 294 + .../cobol_data}/version.mlt | 0 src/lsp/cobol_indent/TODO.md | 15 + src/lsp/cobol_indent/cobol_indent.ml | 30 + src/lsp/cobol_indent/dune | 26 + src/lsp/cobol_indent/indent_check.ml | 1218 +++ src/lsp/cobol_indent/indent_check.mli | 17 + src/lsp/cobol_indent/indent_config.ml | 82 + src/lsp/cobol_indent/indent_config.mli | 17 + src/lsp/cobol_indent/indent_keywords.ml | 179 + src/lsp/cobol_indent/indent_keywords.mli | 27 + src/lsp/cobol_indent/indent_type.ml | 169 + src/lsp/cobol_indent/indent_util.ml | 150 + src/lsp/cobol_indent/indent_util.mli | 44 + src/lsp/cobol_indent/indenter.ml | 94 + src/lsp/cobol_indent/indenter.mli | 20 + src/lsp/cobol_indent/index.mld | 9 + src/lsp/cobol_indent/package.toml | 76 + src/lsp/cobol_indent/user_def | 1 + .../cobol_indent}/version.mlt | 0 src/lsp/cobol_lsp/README.md | 5 + src/lsp/cobol_lsp/TODO.md | 3 + src/lsp/cobol_lsp/cobol_lsp.ml | 41 + src/lsp/cobol_lsp/dune | 26 + src/lsp/cobol_lsp/index.mld | 9 + src/lsp/cobol_lsp/lsp_completion.ml | 103 + src/lsp/cobol_lsp/lsp_completion_keywords.ml | 329 + src/lsp/cobol_lsp/lsp_diagnostics.ml | 89 + src/lsp/cobol_lsp/lsp_diagnostics.mli | 40 + src/lsp/cobol_lsp/lsp_document.ml | 219 + src/lsp/cobol_lsp/lsp_imports.ml | 24 + src/lsp/cobol_lsp/lsp_io.ml | 123 + src/lsp/cobol_lsp/lsp_io.mli | 39 + src/lsp/cobol_lsp/lsp_lookup.ml | 523 + src/lsp/cobol_lsp/lsp_notif.ml | 42 + src/lsp/cobol_lsp/lsp_notif.mli | 14 + src/lsp/cobol_lsp/lsp_position.ml | 82 + src/lsp/cobol_lsp/lsp_position.mli | 61 + src/lsp/cobol_lsp/lsp_project.ml | 322 + src/lsp/cobol_lsp/lsp_project.mli | 93 + src/lsp/cobol_lsp/lsp_project_cache.ml | 141 + src/lsp/cobol_lsp/lsp_project_cache.mli | 56 + src/lsp/cobol_lsp/lsp_request.ml | 379 + src/lsp/cobol_lsp/lsp_request.mli | 41 + src/lsp/cobol_lsp/lsp_semantic.ml | 622 ++ src/lsp/cobol_lsp/lsp_server.ml | 200 + src/lsp/cobol_lsp/lsp_server.mli | 81 + src/lsp/cobol_lsp/lsp_server_loop.ml | 68 + src/lsp/cobol_lsp/lsp_server_loop.mli | 21 + src/lsp/cobol_lsp/lsp_utils.ml | 44 + src/lsp/cobol_lsp/lsp_utils.mli | 17 + src/lsp/cobol_lsp/package.toml | 83 + .../cobol_lsp}/version.mlt | 0 src/lsp/cobol_parser/README.md | 6 + src/lsp/cobol_parser/cobol_parser.ml | 82 + src/lsp/cobol_parser/context.ml | 87 + src/lsp/cobol_parser/context.mli | 33 + src/lsp/cobol_parser/context/dune | 9 + src/lsp/cobol_parser/context/gen_context.ml | 109 + src/lsp/cobol_parser/context/gen_contexts.ml | 153 + src/lsp/cobol_parser/contexts.ml | 55 + src/lsp/cobol_parser/dune | 93 + src/lsp/cobol_parser/grammar.mly | 3962 +++++++ src/lsp/cobol_parser/grammar_common.mly | 1 + src/lsp/cobol_parser/grammar_context.ml | 137 + src/lsp/cobol_parser/grammar_contexts.ml | 625 ++ src/lsp/cobol_parser/grammar_post_actions.ml | 45 + src/lsp/cobol_parser/grammar_printer.ml | 6378 ++++++++++++ src/lsp/cobol_parser/grammar_printer.mli | 18 + src/lsp/cobol_parser/grammar_recover.ml | 9241 +++++++++++++++++ src/lsp/cobol_parser/grammar_recover.mli | 31 + src/lsp/cobol_parser/grammar_tokens.mly | 1156 +++ src/lsp/cobol_parser/grammar_utils.ml | 90 + src/lsp/cobol_parser/grammar_utils.mli | 44 + src/lsp/cobol_parser/index.mld | 10 + src/lsp/cobol_parser/keywords/dune | 3 + src/lsp/cobol_parser/keywords/gen_keywords.ml | 121 + src/lsp/cobol_parser/pTree.ml | 46 + src/lsp/cobol_parser/pTree_visitor.ml | 83 + src/lsp/cobol_parser/package.toml | 151 + src/lsp/cobol_parser/parser_engine.ml | 505 + src/lsp/cobol_parser/parser_engine.mli | 33 + src/lsp/cobol_parser/parser_options.ml | 45 + src/lsp/cobol_parser/post/dune | 3 + src/lsp/cobol_parser/post/gen_post_actions.ml | 172 + src/lsp/cobol_parser/printer | 1 + src/lsp/cobol_parser/recover | 1 + src/lsp/cobol_parser/recovery.ml | 199 + src/lsp/cobol_parser/text_categorizer.mll | 103 + src/lsp/cobol_parser/text_keywords.ml | 1102 ++ src/lsp/cobol_parser/text_keywords.mli | 25 + src/lsp/cobol_parser/text_lexer.ml | 256 + src/lsp/cobol_parser/text_lexer.mli | 90 + src/lsp/cobol_parser/text_tokenizer.ml | 511 + src/lsp/cobol_parser/text_tokenizer.mli | 97 + .../cobol_parser}/version.mlt | 0 src/lsp/cobol_preproc/README.md | 5 + src/lsp/cobol_preproc/cobol_preproc.ml | 22 + src/lsp/cobol_preproc/copybook.ml | 52 + src/lsp/cobol_preproc/copybook.mli | 27 + src/lsp/cobol_preproc/dune | 44 + src/lsp/cobol_preproc/grammar_common.mly | 103 + src/lsp/cobol_preproc/index.mld | 9 + src/lsp/cobol_preproc/package.toml | 99 + src/lsp/cobol_preproc/preproc.ml | 740 ++ src/lsp/cobol_preproc/preproc.mli | 174 + src/lsp/cobol_preproc/preproc_engine.ml | 453 + src/lsp/cobol_preproc/preproc_engine.mli | 113 + src/lsp/cobol_preproc/preproc_grammar.mly | 177 + src/lsp/cobol_preproc/preproc_grammar_sig.ml | 67 + src/lsp/cobol_preproc/preproc_keywords.ml | 31 + src/lsp/cobol_preproc/preproc_tokens.mly | 50 + src/lsp/cobol_preproc/preproc_utils.ml | 62 + src/lsp/cobol_preproc/preproc_utils.mli | 29 + src/lsp/cobol_preproc/src_lexer.mli | 25 + src/lsp/cobol_preproc/src_lexer.mll | 528 + src/lsp/cobol_preproc/src_lexing.ml | 676 ++ src/lsp/cobol_preproc/src_lexing.mli | 121 + src/lsp/cobol_preproc/src_overlay.ml | 157 + src/lsp/cobol_preproc/src_overlay.mli | 54 + src/lsp/cobol_preproc/text.ml | 134 + src/lsp/cobol_preproc/text.mli | 55 + src/lsp/cobol_preproc/text_printer.ml | 172 + src/lsp/cobol_preproc/text_printer.mli | 17 + src/lsp/cobol_preproc/text_supplier.ml | 84 + src/lsp/cobol_preproc/text_supplier.mli | 26 + src/lsp/cobol_preproc/text_types.ml | 53 + .../cobol_preproc}/version.mlt | 0 src/lsp/cobol_typeck/README.md | 5 + src/lsp/cobol_typeck/cobol_typeck.ml | 1175 +++ src/lsp/cobol_typeck/cobol_typeck.mli | 33 + src/lsp/cobol_typeck/cobol_validation.ml | 102 + src/lsp/cobol_typeck/cobol_validation.mli | 20 + src/lsp/cobol_typeck/dune | 26 + src/lsp/cobol_typeck/grouped_ast.ml | 69 + src/lsp/cobol_typeck/index.mld | 9 + src/lsp/cobol_typeck/mangling.ml | 220 + src/lsp/cobol_typeck/package.toml | 78 + .../cobol_typeck}/version.mlt | 0 src/lsp/ebcdic_lib/README.md | 4 + src/lsp/ebcdic_lib/dune | 26 + src/lsp/ebcdic_lib/ebcdic.ml | 658 ++ src/lsp/ebcdic_lib/ebcdic.mli | 30 + .../ebcdic_lib/ebcdic_version.mlt} | 0 src/lsp/ebcdic_lib/index.mld | 11 + src/lsp/ebcdic_lib/package.toml | 74 + src/lsp/ebcdic_lib/version.mlt | 30 + src/lsp/ppx_cobcflags/README.md | 5 + src/lsp/ppx_cobcflags/dune | 20 + src/lsp/ppx_cobcflags/flag.ml | 75 + src/lsp/ppx_cobcflags/flag_rq.ml | 134 + src/lsp/ppx_cobcflags/index.mld | 8 + src/lsp/ppx_cobcflags/main.ml | 21 + src/lsp/ppx_cobcflags/package.toml | 74 + src/lsp/ppx_cobcflags/version.mlt | 30 + src/lsp/pretty/README.md | 6 + src/lsp/pretty/dune | 26 + src/lsp/pretty/index.mld | 10 + src/lsp/pretty/package.toml | 77 + src/lsp/pretty/pretty.ml | 191 + src/lsp/pretty/pretty.mli | 62 + src/lsp/pretty/version.mlt | 30 + src/lsp/superbol-free/README.md | 3 + src/lsp/superbol-free/dune | 35 + src/lsp/superbol-free/index.mld | 7 + src/lsp/superbol-free/linking_flags.sh | 79 + .../superbol-free/linking_flags.sh.drom-tpl | 79 + src/lsp/superbol-free/main.ml | 14 + src/lsp/superbol-free/package.toml | 77 + .../superbol_free_lib/command_indent_file.ml | 56 + .../superbol_free_lib/command_indent_range.ml | 66 + src/lsp/superbol_free_lib/command_lsp.ml | 35 + src/lsp/superbol_free_lib/command_pp.ml | 82 + src/lsp/superbol_free_lib/command_texi2rst.ml | 1474 +++ src/lsp/superbol_free_lib/common_args.ml | 141 + src/lsp/superbol_free_lib/common_args.mli | 23 + src/lsp/superbol_free_lib/config.ml | 14 + src/lsp/superbol_free_lib/dune | 26 + src/lsp/superbol_free_lib/globals.ml | 34 + src/lsp/superbol_free_lib/main.ml | 36 + src/lsp/superbol_free_lib/package.toml | 85 + src/lsp/superbol_free_lib/version.mlt | 30 + src/{ => vscode}/interop-js-stubs/dune | 0 src/{ => vscode}/interop-js-stubs/interop.ml | 14 + src/{ => vscode}/interop-js-stubs/interop.mli | 14 + .../interop-js-stubs/package.toml | 0 src/vscode/interop-js-stubs/version.mlt | 30 + src/{ => vscode}/node-js-stubs/dune | 0 src/{ => vscode}/node-js-stubs/node.ml | 14 + src/{ => vscode}/node-js-stubs/node.mli | 14 + src/{ => vscode}/node-js-stubs/node_stub.js | 0 src/{ => vscode}/node-js-stubs/package.toml | 0 src/vscode/node-js-stubs/version.mlt | 30 + src/{ => vscode}/polka-js-stubs/dune | 0 src/{ => vscode}/polka-js-stubs/package.toml | 0 src/{ => vscode}/polka-js-stubs/polka.ml | 14 + src/{ => vscode}/polka-js-stubs/polka.mli | 14 + src/{ => vscode}/polka-js-stubs/polka_stub.js | 0 src/vscode/polka-js-stubs/version.mlt | 30 + .../superbol-vscode-platform/debugger.ml | 3 + .../superbol-vscode-platform/dune | 0 .../superbol-vscode-platform/linking_flags.sh | 0 .../superbol-vscode-platform/package.toml | 0 .../superbol_languageclient.ml | 4 +- .../superbol_languageclient.mli | 3 + .../superbol_tasks.ml | 3 + .../superbol_tasks.mli | 3 + .../superbol_vscode_platform.ml | 3 + .../superbol_vscode_platform.mli | 3 + .../superbol-vscode-platform/version.mlt | 30 + .../vscode-debugadapter/debugSession.ml | 3 + src/{ => vscode}/vscode-debugadapter/dune | 0 .../vscode-debugadapter/messages.ml | 3 + .../vscode-debugadapter/package.toml | 0 .../vscode-debugadapter/protocol.ml | 3 + src/vscode/vscode-debugadapter/version.mlt | 30 + .../vscode_debugadapter_stub.js | 0 .../vscode-debugprotocol/debugProtocol.ml | 3 + src/{ => vscode}/vscode-debugprotocol/dune | 0 .../vscode-debugprotocol/package.toml | 0 src/vscode/vscode-debugprotocol/version.mlt | 30 + .../vscode_debugprotocol_stub.js | 0 src/{ => vscode}/vscode-js-stubs/dune | 0 src/{ => vscode}/vscode-js-stubs/package.toml | 0 src/{ => vscode}/vscode-js-stubs/typings.ml | 3 + src/vscode/vscode-js-stubs/version.mlt | 30 + src/{ => vscode}/vscode-js-stubs/vscode.ml | 14 + src/{ => vscode}/vscode-js-stubs/vscode.mli | 14 + .../vscode-js-stubs/vscode_stub.js | 0 src/{ => vscode}/vscode-json/dune | 0 src/{ => vscode}/vscode-json/grammar.ml | 3 + src/{ => vscode}/vscode-json/index.mld | 0 src/{ => vscode}/vscode-json/language.ml | 3 + src/{ => vscode}/vscode-json/linking_flags.sh | 0 src/{ => vscode}/vscode-json/main.ml | 3 + src/{ => vscode}/vscode-json/main.mli | 3 + src/{ => vscode}/vscode-json/manifest.ml | 3 + src/{ => vscode}/vscode-json/package.toml | 0 src/{ => vscode}/vscode-json/snippets.ml | 3 + src/{ => vscode}/vscode-json/tasks.ml | 3 + src/{ => vscode}/vscode-json/tests/README.md | 0 .../vscode-json/tests/extensions.json | 0 .../vscode-json/tests/launch-nodejs.json | 0 .../vscode-json/tests/launch.json | 0 .../vscode-json/tests/settings.json | 0 .../vscode-json/tests/shared.code-snippets | 0 src/{ => vscode}/vscode-json/tests/tasks.json | 0 src/vscode/vscode-json/version.mlt | 30 + .../vscode-languageclient-js-stubs/dune | 0 .../package.toml | 0 .../version.mlt | 30 + .../vscode_languageclient.ml | 14 + .../vscode_languageclient.mli | 14 + .../vscode_languageclient_stub.js | 0 src/{ => vscode}/vscode-package-json/dune | 0 .../vscode-package-json/linking_flags.sh | 0 src/{ => vscode}/vscode-package-json/main.ml | 3 + .../vscode-package-json/package.toml | 0 .../vscode-package-json/project.ml | 3 + .../vscode-package-json/project.mli | 3 + src/vscode/vscode-package-json/version.mlt | 30 + 384 files changed, 66392 insertions(+), 225 deletions(-) create mode 100644 .gitmodules create mode 100644 emacs/README.md create mode 100644 emacs/cobol-mode.el create mode 160000 import/gnucobol create mode 160000 import/merlin create mode 100644 opam/cobol_ast.opam create mode 100644 opam/cobol_common.opam create mode 100644 opam/cobol_config.opam create mode 100644 opam/cobol_data.opam create mode 100644 opam/cobol_indent.opam create mode 100644 opam/cobol_lsp.opam create mode 100644 opam/cobol_parser.opam create mode 100644 opam/cobol_preproc.opam create mode 100644 opam/cobol_typeck.opam create mode 100644 opam/ebcdic_lib.opam create mode 100644 opam/ppx_cobcflags.opam create mode 100644 opam/pretty.opam create mode 100644 opam/superbol-free.opam create mode 100644 opam/superbol_free_lib.opam create mode 100755 scripts/before-sphinx.sh create mode 100644 sphinx/commands.rst create mode 100644 sphinx/conf.py.drom-tpl create mode 100644 sphinx/debug.rst create mode 100644 sphinx/emacs.rst create mode 100644 sphinx/install-vscode.rst create mode 100644 sphinx/lsp.rst create mode 100644 sphinx/platform.rst create mode 100644 src/lsp/cobol_ast/README.md create mode 100644 src/lsp/cobol_ast/abstract.ml create mode 100644 src/lsp/cobol_ast/abstract_visitor.ml create mode 100644 src/lsp/cobol_ast/ast.ml create mode 100644 src/lsp/cobol_ast/branching_statements.ml create mode 100644 src/lsp/cobol_ast/cobol_ast.ml create mode 100644 src/lsp/cobol_ast/data_descr.ml create mode 100644 src/lsp/cobol_ast/dune create mode 100644 src/lsp/cobol_ast/helpers.ml create mode 100644 src/lsp/cobol_ast/index.mld create mode 100644 src/lsp/cobol_ast/misc_descr.ml create mode 100644 src/lsp/cobol_ast/numericals.ml create mode 100644 src/lsp/cobol_ast/operands.ml create mode 100644 src/lsp/cobol_ast/operands_visitor.ml create mode 100644 src/lsp/cobol_ast/package.toml create mode 100644 src/lsp/cobol_ast/raw.ml create mode 100644 src/lsp/cobol_ast/raw_compilation_group_visitor.ml create mode 100644 src/lsp/cobol_ast/raw_data_division_visitor.ml create mode 100644 src/lsp/cobol_ast/raw_data_sections_visitor.ml create mode 100644 src/lsp/cobol_ast/raw_misc_sections_visitor.ml create mode 100644 src/lsp/cobol_ast/raw_proc_division_visitor.ml create mode 100644 src/lsp/cobol_ast/raw_statements_visitor.ml create mode 100644 src/lsp/cobol_ast/raw_visitor.ml create mode 100644 src/lsp/cobol_ast/simple_statements.ml create mode 100644 src/lsp/cobol_ast/terms.ml create mode 100644 src/lsp/cobol_ast/terms_visitor.ml create mode 100644 src/lsp/cobol_ast/traversal.ml rename src/{interop-js-stubs => lsp/cobol_ast}/version.mlt (100%) create mode 100644 src/lsp/cobol_common/README.md create mode 100644 src/lsp/cobol_common/basics.ml create mode 100644 src/lsp/cobol_common/behaviors.ml create mode 100644 src/lsp/cobol_common/cobol_common.ml create mode 100644 src/lsp/cobol_common/cobol_common.mli create mode 100644 src/lsp/cobol_common/diagnostics.ml create mode 100644 src/lsp/cobol_common/diagnostics.mli create mode 100644 src/lsp/cobol_common/diagnostics_sigs.ml create mode 100644 src/lsp/cobol_common/dune create mode 100644 src/lsp/cobol_common/index.mld create mode 100644 src/lsp/cobol_common/msgs.ml create mode 100644 src/lsp/cobol_common/package.toml create mode 100644 src/lsp/cobol_common/srcloc.ml create mode 100644 src/lsp/cobol_common/srcloc.mli create mode 100644 src/lsp/cobol_common/tokenizing.ml create mode 100644 src/lsp/cobol_common/tokenizing.mli rename src/{node-js-stubs => lsp/cobol_common}/version.mlt (100%) create mode 100644 src/lsp/cobol_common/visitor.ml create mode 100644 src/lsp/cobol_config/README.md create mode 100644 src/lsp/cobol_config/cobol_config.ml create mode 100644 src/lsp/cobol_config/cobol_config.mli create mode 100644 src/lsp/cobol_config/conf_ast.ml create mode 100644 src/lsp/cobol_config/conf_lexer.mll create mode 100644 src/lsp/cobol_config/conf_parser.messages create mode 100644 src/lsp/cobol_config/conf_parser.mly create mode 100644 src/lsp/cobol_config/default.ml create mode 100644 src/lsp/cobol_config/default.mli create mode 100644 src/lsp/cobol_config/dune create mode 100644 src/lsp/cobol_config/from_file.ml create mode 100644 src/lsp/cobol_config/from_file.mli create mode 100644 src/lsp/cobol_config/index.mld create mode 100644 src/lsp/cobol_config/options.ml create mode 100644 src/lsp/cobol_config/options.mli create mode 100644 src/lsp/cobol_config/package.toml create mode 100644 src/lsp/cobol_config/reserved_words.ml create mode 100644 src/lsp/cobol_config/reserved_words.mli create mode 100644 src/lsp/cobol_config/types.ml rename src/{polka-js-stubs => lsp/cobol_config}/version.mlt (100%) create mode 100644 src/lsp/cobol_config/words.ml create mode 100644 src/lsp/cobol_data/README.md create mode 100644 src/lsp/cobol_data/cobol_data.ml create mode 100644 src/lsp/cobol_data/compilation_unit.ml create mode 100644 src/lsp/cobol_data/dune create mode 100644 src/lsp/cobol_data/env.ml create mode 100644 src/lsp/cobol_data/group.ml create mode 100644 src/lsp/cobol_data/group.mli create mode 100644 src/lsp/cobol_data/index.mld create mode 100644 src/lsp/cobol_data/mangling.ml create mode 100644 src/lsp/cobol_data/mangling.mli create mode 100644 src/lsp/cobol_data/package.toml create mode 100644 src/lsp/cobol_data/picture.ml create mode 100644 src/lsp/cobol_data/picture.mli create mode 100644 src/lsp/cobol_data/pictured_ast.ml create mode 100644 src/lsp/cobol_data/qualmap.ml create mode 100644 src/lsp/cobol_data/qualmap.mli create mode 100644 src/lsp/cobol_data/types.ml create mode 100644 src/lsp/cobol_data/typing.ml rename src/{superbol-vscode-platform => lsp/cobol_data}/version.mlt (100%) create mode 100644 src/lsp/cobol_indent/TODO.md create mode 100644 src/lsp/cobol_indent/cobol_indent.ml create mode 100644 src/lsp/cobol_indent/dune create mode 100644 src/lsp/cobol_indent/indent_check.ml create mode 100644 src/lsp/cobol_indent/indent_check.mli create mode 100644 src/lsp/cobol_indent/indent_config.ml create mode 100644 src/lsp/cobol_indent/indent_config.mli create mode 100644 src/lsp/cobol_indent/indent_keywords.ml create mode 100644 src/lsp/cobol_indent/indent_keywords.mli create mode 100644 src/lsp/cobol_indent/indent_type.ml create mode 100644 src/lsp/cobol_indent/indent_util.ml create mode 100644 src/lsp/cobol_indent/indent_util.mli create mode 100644 src/lsp/cobol_indent/indenter.ml create mode 100644 src/lsp/cobol_indent/indenter.mli create mode 100644 src/lsp/cobol_indent/index.mld create mode 100644 src/lsp/cobol_indent/package.toml create mode 100644 src/lsp/cobol_indent/user_def rename src/{vscode-debugadapter => lsp/cobol_indent}/version.mlt (100%) create mode 100644 src/lsp/cobol_lsp/README.md create mode 100644 src/lsp/cobol_lsp/TODO.md create mode 100644 src/lsp/cobol_lsp/cobol_lsp.ml create mode 100644 src/lsp/cobol_lsp/dune create mode 100644 src/lsp/cobol_lsp/index.mld create mode 100644 src/lsp/cobol_lsp/lsp_completion.ml create mode 100644 src/lsp/cobol_lsp/lsp_completion_keywords.ml create mode 100644 src/lsp/cobol_lsp/lsp_diagnostics.ml create mode 100644 src/lsp/cobol_lsp/lsp_diagnostics.mli create mode 100644 src/lsp/cobol_lsp/lsp_document.ml create mode 100644 src/lsp/cobol_lsp/lsp_imports.ml create mode 100644 src/lsp/cobol_lsp/lsp_io.ml create mode 100644 src/lsp/cobol_lsp/lsp_io.mli create mode 100644 src/lsp/cobol_lsp/lsp_lookup.ml create mode 100644 src/lsp/cobol_lsp/lsp_notif.ml create mode 100644 src/lsp/cobol_lsp/lsp_notif.mli create mode 100644 src/lsp/cobol_lsp/lsp_position.ml create mode 100644 src/lsp/cobol_lsp/lsp_position.mli create mode 100644 src/lsp/cobol_lsp/lsp_project.ml create mode 100644 src/lsp/cobol_lsp/lsp_project.mli create mode 100644 src/lsp/cobol_lsp/lsp_project_cache.ml create mode 100644 src/lsp/cobol_lsp/lsp_project_cache.mli create mode 100644 src/lsp/cobol_lsp/lsp_request.ml create mode 100644 src/lsp/cobol_lsp/lsp_request.mli create mode 100644 src/lsp/cobol_lsp/lsp_semantic.ml create mode 100644 src/lsp/cobol_lsp/lsp_server.ml create mode 100644 src/lsp/cobol_lsp/lsp_server.mli create mode 100644 src/lsp/cobol_lsp/lsp_server_loop.ml create mode 100644 src/lsp/cobol_lsp/lsp_server_loop.mli create mode 100644 src/lsp/cobol_lsp/lsp_utils.ml create mode 100644 src/lsp/cobol_lsp/lsp_utils.mli create mode 100644 src/lsp/cobol_lsp/package.toml rename src/{vscode-debugprotocol => lsp/cobol_lsp}/version.mlt (100%) create mode 100644 src/lsp/cobol_parser/README.md create mode 100644 src/lsp/cobol_parser/cobol_parser.ml create mode 100644 src/lsp/cobol_parser/context.ml create mode 100644 src/lsp/cobol_parser/context.mli create mode 100644 src/lsp/cobol_parser/context/dune create mode 100644 src/lsp/cobol_parser/context/gen_context.ml create mode 100644 src/lsp/cobol_parser/context/gen_contexts.ml create mode 100644 src/lsp/cobol_parser/contexts.ml create mode 100644 src/lsp/cobol_parser/dune create mode 100644 src/lsp/cobol_parser/grammar.mly create mode 120000 src/lsp/cobol_parser/grammar_common.mly create mode 100644 src/lsp/cobol_parser/grammar_context.ml create mode 100644 src/lsp/cobol_parser/grammar_contexts.ml create mode 100644 src/lsp/cobol_parser/grammar_post_actions.ml create mode 100644 src/lsp/cobol_parser/grammar_printer.ml create mode 100644 src/lsp/cobol_parser/grammar_printer.mli create mode 100644 src/lsp/cobol_parser/grammar_recover.ml create mode 100644 src/lsp/cobol_parser/grammar_recover.mli create mode 100644 src/lsp/cobol_parser/grammar_tokens.mly create mode 100644 src/lsp/cobol_parser/grammar_utils.ml create mode 100644 src/lsp/cobol_parser/grammar_utils.mli create mode 100644 src/lsp/cobol_parser/index.mld create mode 100644 src/lsp/cobol_parser/keywords/dune create mode 100644 src/lsp/cobol_parser/keywords/gen_keywords.ml create mode 100644 src/lsp/cobol_parser/pTree.ml create mode 100644 src/lsp/cobol_parser/pTree_visitor.ml create mode 100644 src/lsp/cobol_parser/package.toml create mode 100644 src/lsp/cobol_parser/parser_engine.ml create mode 100644 src/lsp/cobol_parser/parser_engine.mli create mode 100644 src/lsp/cobol_parser/parser_options.ml create mode 100644 src/lsp/cobol_parser/post/dune create mode 100644 src/lsp/cobol_parser/post/gen_post_actions.ml create mode 120000 src/lsp/cobol_parser/printer create mode 120000 src/lsp/cobol_parser/recover create mode 100644 src/lsp/cobol_parser/recovery.ml create mode 100644 src/lsp/cobol_parser/text_categorizer.mll create mode 100644 src/lsp/cobol_parser/text_keywords.ml create mode 100644 src/lsp/cobol_parser/text_keywords.mli create mode 100644 src/lsp/cobol_parser/text_lexer.ml create mode 100644 src/lsp/cobol_parser/text_lexer.mli create mode 100644 src/lsp/cobol_parser/text_tokenizer.ml create mode 100644 src/lsp/cobol_parser/text_tokenizer.mli rename src/{vscode-js-stubs => lsp/cobol_parser}/version.mlt (100%) create mode 100644 src/lsp/cobol_preproc/README.md create mode 100644 src/lsp/cobol_preproc/cobol_preproc.ml create mode 100644 src/lsp/cobol_preproc/copybook.ml create mode 100644 src/lsp/cobol_preproc/copybook.mli create mode 100644 src/lsp/cobol_preproc/dune create mode 100644 src/lsp/cobol_preproc/grammar_common.mly create mode 100644 src/lsp/cobol_preproc/index.mld create mode 100644 src/lsp/cobol_preproc/package.toml create mode 100644 src/lsp/cobol_preproc/preproc.ml create mode 100644 src/lsp/cobol_preproc/preproc.mli create mode 100644 src/lsp/cobol_preproc/preproc_engine.ml create mode 100644 src/lsp/cobol_preproc/preproc_engine.mli create mode 100644 src/lsp/cobol_preproc/preproc_grammar.mly create mode 100644 src/lsp/cobol_preproc/preproc_grammar_sig.ml create mode 100644 src/lsp/cobol_preproc/preproc_keywords.ml create mode 100644 src/lsp/cobol_preproc/preproc_tokens.mly create mode 100644 src/lsp/cobol_preproc/preproc_utils.ml create mode 100644 src/lsp/cobol_preproc/preproc_utils.mli create mode 100644 src/lsp/cobol_preproc/src_lexer.mli create mode 100644 src/lsp/cobol_preproc/src_lexer.mll create mode 100644 src/lsp/cobol_preproc/src_lexing.ml create mode 100644 src/lsp/cobol_preproc/src_lexing.mli create mode 100644 src/lsp/cobol_preproc/src_overlay.ml create mode 100644 src/lsp/cobol_preproc/src_overlay.mli create mode 100644 src/lsp/cobol_preproc/text.ml create mode 100644 src/lsp/cobol_preproc/text.mli create mode 100644 src/lsp/cobol_preproc/text_printer.ml create mode 100644 src/lsp/cobol_preproc/text_printer.mli create mode 100644 src/lsp/cobol_preproc/text_supplier.ml create mode 100644 src/lsp/cobol_preproc/text_supplier.mli create mode 100644 src/lsp/cobol_preproc/text_types.ml rename src/{vscode-json => lsp/cobol_preproc}/version.mlt (100%) create mode 100644 src/lsp/cobol_typeck/README.md create mode 100644 src/lsp/cobol_typeck/cobol_typeck.ml create mode 100644 src/lsp/cobol_typeck/cobol_typeck.mli create mode 100644 src/lsp/cobol_typeck/cobol_validation.ml create mode 100644 src/lsp/cobol_typeck/cobol_validation.mli create mode 100644 src/lsp/cobol_typeck/dune create mode 100644 src/lsp/cobol_typeck/grouped_ast.ml create mode 100644 src/lsp/cobol_typeck/index.mld create mode 100644 src/lsp/cobol_typeck/mangling.ml create mode 100644 src/lsp/cobol_typeck/package.toml rename src/{vscode-languageclient-js-stubs => lsp/cobol_typeck}/version.mlt (100%) create mode 100644 src/lsp/ebcdic_lib/README.md create mode 100644 src/lsp/ebcdic_lib/dune create mode 100644 src/lsp/ebcdic_lib/ebcdic.ml create mode 100644 src/lsp/ebcdic_lib/ebcdic.mli rename src/{vscode-package-json/version.mlt => lsp/ebcdic_lib/ebcdic_version.mlt} (100%) create mode 100644 src/lsp/ebcdic_lib/index.mld create mode 100644 src/lsp/ebcdic_lib/package.toml create mode 100644 src/lsp/ebcdic_lib/version.mlt create mode 100644 src/lsp/ppx_cobcflags/README.md create mode 100644 src/lsp/ppx_cobcflags/dune create mode 100644 src/lsp/ppx_cobcflags/flag.ml create mode 100644 src/lsp/ppx_cobcflags/flag_rq.ml create mode 100644 src/lsp/ppx_cobcflags/index.mld create mode 100644 src/lsp/ppx_cobcflags/main.ml create mode 100644 src/lsp/ppx_cobcflags/package.toml create mode 100644 src/lsp/ppx_cobcflags/version.mlt create mode 100644 src/lsp/pretty/README.md create mode 100644 src/lsp/pretty/dune create mode 100644 src/lsp/pretty/index.mld create mode 100644 src/lsp/pretty/package.toml create mode 100644 src/lsp/pretty/pretty.ml create mode 100644 src/lsp/pretty/pretty.mli create mode 100644 src/lsp/pretty/version.mlt create mode 100644 src/lsp/superbol-free/README.md create mode 100644 src/lsp/superbol-free/dune create mode 100644 src/lsp/superbol-free/index.mld create mode 100644 src/lsp/superbol-free/linking_flags.sh create mode 100644 src/lsp/superbol-free/linking_flags.sh.drom-tpl create mode 100644 src/lsp/superbol-free/main.ml create mode 100644 src/lsp/superbol-free/package.toml create mode 100644 src/lsp/superbol_free_lib/command_indent_file.ml create mode 100644 src/lsp/superbol_free_lib/command_indent_range.ml create mode 100644 src/lsp/superbol_free_lib/command_lsp.ml create mode 100644 src/lsp/superbol_free_lib/command_pp.ml create mode 100644 src/lsp/superbol_free_lib/command_texi2rst.ml create mode 100644 src/lsp/superbol_free_lib/common_args.ml create mode 100644 src/lsp/superbol_free_lib/common_args.mli create mode 100644 src/lsp/superbol_free_lib/config.ml create mode 100644 src/lsp/superbol_free_lib/dune create mode 100644 src/lsp/superbol_free_lib/globals.ml create mode 100644 src/lsp/superbol_free_lib/main.ml create mode 100644 src/lsp/superbol_free_lib/package.toml create mode 100644 src/lsp/superbol_free_lib/version.mlt rename src/{ => vscode}/interop-js-stubs/dune (100%) rename src/{ => vscode}/interop-js-stubs/interop.ml (80%) rename src/{ => vscode}/interop-js-stubs/interop.mli (66%) rename src/{ => vscode}/interop-js-stubs/package.toml (100%) create mode 100644 src/vscode/interop-js-stubs/version.mlt rename src/{ => vscode}/node-js-stubs/dune (100%) rename src/{ => vscode}/node-js-stubs/node.ml (91%) rename src/{ => vscode}/node-js-stubs/node.mli (82%) rename src/{ => vscode}/node-js-stubs/node_stub.js (100%) rename src/{ => vscode}/node-js-stubs/package.toml (100%) create mode 100644 src/vscode/node-js-stubs/version.mlt rename src/{ => vscode}/polka-js-stubs/dune (100%) rename src/{ => vscode}/polka-js-stubs/package.toml (100%) rename src/{ => vscode}/polka-js-stubs/polka.ml (64%) rename src/{ => vscode}/polka-js-stubs/polka.mli (53%) rename src/{ => vscode}/polka-js-stubs/polka_stub.js (100%) create mode 100644 src/vscode/polka-js-stubs/version.mlt rename src/{ => vscode}/superbol-vscode-platform/debugger.ml (90%) rename src/{ => vscode}/superbol-vscode-platform/dune (100%) rename src/{ => vscode}/superbol-vscode-platform/linking_flags.sh (100%) rename src/{ => vscode}/superbol-vscode-platform/package.toml (100%) rename src/{ => vscode}/superbol-vscode-platform/superbol_languageclient.ml (84%) rename src/{ => vscode}/superbol-vscode-platform/superbol_languageclient.mli (79%) rename src/{ => vscode}/superbol-vscode-platform/superbol_tasks.ml (95%) rename src/{ => vscode}/superbol-vscode-platform/superbol_tasks.mli (78%) rename src/{ => vscode}/superbol-vscode-platform/superbol_vscode_platform.ml (96%) rename src/{ => vscode}/superbol-vscode-platform/superbol_vscode_platform.mli (77%) create mode 100644 src/vscode/superbol-vscode-platform/version.mlt rename src/{ => vscode}/vscode-debugadapter/debugSession.ml (81%) rename src/{ => vscode}/vscode-debugadapter/dune (100%) rename src/{ => vscode}/vscode-debugadapter/messages.ml (87%) rename src/{ => vscode}/vscode-debugadapter/package.toml (100%) rename src/{ => vscode}/vscode-debugadapter/protocol.ml (93%) create mode 100644 src/vscode/vscode-debugadapter/version.mlt rename src/{ => vscode}/vscode-debugadapter/vscode_debugadapter_stub.js (100%) rename src/{ => vscode}/vscode-debugprotocol/debugProtocol.ml (99%) rename src/{ => vscode}/vscode-debugprotocol/dune (100%) rename src/{ => vscode}/vscode-debugprotocol/package.toml (100%) create mode 100644 src/vscode/vscode-debugprotocol/version.mlt rename src/{ => vscode}/vscode-debugprotocol/vscode_debugprotocol_stub.js (100%) rename src/{ => vscode}/vscode-js-stubs/dune (100%) rename src/{ => vscode}/vscode-js-stubs/package.toml (100%) rename src/{ => vscode}/vscode-js-stubs/typings.ml (87%) create mode 100644 src/vscode/vscode-js-stubs/version.mlt rename src/{ => vscode}/vscode-js-stubs/vscode.ml (98%) rename src/{ => vscode}/vscode-js-stubs/vscode.mli (98%) rename src/{ => vscode}/vscode-js-stubs/vscode_stub.js (100%) rename src/{ => vscode}/vscode-json/dune (100%) rename src/{ => vscode}/vscode-json/grammar.ml (98%) rename src/{ => vscode}/vscode-json/index.mld (100%) rename src/{ => vscode}/vscode-json/language.ml (89%) rename src/{ => vscode}/vscode-json/linking_flags.sh (100%) rename src/{ => vscode}/vscode-json/main.ml (96%) rename src/{ => vscode}/vscode-json/main.mli (82%) rename src/{ => vscode}/vscode-json/manifest.ml (98%) rename src/{ => vscode}/vscode-json/package.toml (100%) rename src/{ => vscode}/vscode-json/snippets.ml (83%) rename src/{ => vscode}/vscode-json/tasks.ml (98%) rename src/{ => vscode}/vscode-json/tests/README.md (100%) rename src/{ => vscode}/vscode-json/tests/extensions.json (100%) rename src/{ => vscode}/vscode-json/tests/launch-nodejs.json (100%) rename src/{ => vscode}/vscode-json/tests/launch.json (100%) rename src/{ => vscode}/vscode-json/tests/settings.json (100%) rename src/{ => vscode}/vscode-json/tests/shared.code-snippets (100%) rename src/{ => vscode}/vscode-json/tests/tasks.json (100%) create mode 100644 src/vscode/vscode-json/version.mlt rename src/{ => vscode}/vscode-languageclient-js-stubs/dune (100%) rename src/{ => vscode}/vscode-languageclient-js-stubs/package.toml (100%) create mode 100644 src/vscode/vscode-languageclient-js-stubs/version.mlt rename src/{ => vscode}/vscode-languageclient-js-stubs/vscode_languageclient.ml (82%) rename src/{ => vscode}/vscode-languageclient-js-stubs/vscode_languageclient.mli (77%) rename src/{ => vscode}/vscode-languageclient-js-stubs/vscode_languageclient_stub.js (100%) rename src/{ => vscode}/vscode-package-json/dune (100%) rename src/{ => vscode}/vscode-package-json/linking_flags.sh (100%) rename src/{ => vscode}/vscode-package-json/main.ml (88%) rename src/{ => vscode}/vscode-package-json/package.toml (100%) rename src/{ => vscode}/vscode-package-json/project.ml (99%) rename src/{ => vscode}/vscode-package-json/project.mli (77%) create mode 100644 src/vscode/vscode-package-json/version.mlt diff --git a/.drom b/.drom index 54fb43953..449b25ae6 100644 --- a/.drom +++ b/.drom @@ -5,17 +5,17 @@ version:0.9.0 # hash of toml configuration files # used for generation of all files -02ec1db03cfcdaa26f420861e4cbbada:. +704ff33fe81d2283b6fb83bf38fd258e:. # end context for . # begin context for .github/workflows/workflow.yml # file .github/workflows/workflow.yml -d4d64d0996ebf1e854157ace013e0dc4:.github/workflows/workflow.yml +c6c1b4e6ee5a318dd5db6e3f841a556c:.github/workflows/workflow.yml # end context for .github/workflows/workflow.yml # begin context for .gitignore # file .gitignore -8d7837a54815c58ebb1de939c8ea312a:.gitignore +073e803bbf1723d6e227a9fbffe98fb4:.gitignore # end context for .gitignore # begin context for CHANGES.md @@ -30,7 +30,7 @@ d00f73c835ae4a1589d55ebda4ab381b:CHANGES.md # begin context for Makefile # file Makefile -7b235cd906ac2e7c97c9d3254b9b3eef:Makefile +58b368dfbfaad51a22806a8d5808227c:Makefile # end context for Makefile # begin context for README.md @@ -80,9 +80,59 @@ c8281f46ba9a11d0b61bc8ef67eaa357:docs/style.css # begin context for dune-project # file dune-project -be4305154328f2ac976081bd8895b75b:dune-project +ee62251347488c11c3742f152edc1cbe:dune-project # end context for dune-project +# begin context for opam/cobol_ast.opam +# file opam/cobol_ast.opam +1c093791236b02c989e11c8e4277e6b7:opam/cobol_ast.opam +# end context for opam/cobol_ast.opam + +# begin context for opam/cobol_common.opam +# file opam/cobol_common.opam +2684c65869bf3fb2c73292774c68db80:opam/cobol_common.opam +# end context for opam/cobol_common.opam + +# begin context for opam/cobol_config.opam +# file opam/cobol_config.opam +1133aaf02d613ada678aef1c241ff541:opam/cobol_config.opam +# end context for opam/cobol_config.opam + +# begin context for opam/cobol_data.opam +# file opam/cobol_data.opam +4bd93877af6f2710de8abcbc63bab7f6:opam/cobol_data.opam +# end context for opam/cobol_data.opam + +# begin context for opam/cobol_indent.opam +# file opam/cobol_indent.opam +5ca055edfd5fc90ecfac3b085343f8df:opam/cobol_indent.opam +# end context for opam/cobol_indent.opam + +# begin context for opam/cobol_lsp.opam +# file opam/cobol_lsp.opam +78c01ac9d637a0430e4c430d51f4ff6d:opam/cobol_lsp.opam +# end context for opam/cobol_lsp.opam + +# begin context for opam/cobol_parser.opam +# file opam/cobol_parser.opam +6d3c6e64262a9c24c13162ce387faf77:opam/cobol_parser.opam +# end context for opam/cobol_parser.opam + +# begin context for opam/cobol_preproc.opam +# file opam/cobol_preproc.opam +5e6c04d126c530509b79a509dc1ada53:opam/cobol_preproc.opam +# end context for opam/cobol_preproc.opam + +# begin context for opam/cobol_typeck.opam +# file opam/cobol_typeck.opam +8826cd23206fa658d2cc63beccabb5b1:opam/cobol_typeck.opam +# end context for opam/cobol_typeck.opam + +# begin context for opam/ebcdic_lib.opam +# file opam/ebcdic_lib.opam +c365b582bacd1274b4bfb2599d5cd4dc:opam/ebcdic_lib.opam +# end context for opam/ebcdic_lib.opam + # begin context for opam/interop-js-stubs.opam # file opam/interop-js-stubs.opam e557ed4bc7c593fac0877c7327facaf6:opam/interop-js-stubs.opam @@ -103,6 +153,21 @@ dcf0ebaa8b12787df9efcaa0ce8cbbe5:opam/package-json.opam 8f12d7db1569d79ec6043b50df393de3:opam/polka-js-stubs.opam # end context for opam/polka-js-stubs.opam +# begin context for opam/ppx_cobcflags.opam +# file opam/ppx_cobcflags.opam +a71b8dfe67612b506e31c13e89075556:opam/ppx_cobcflags.opam +# end context for opam/ppx_cobcflags.opam + +# begin context for opam/pretty.opam +# file opam/pretty.opam +8cca8f124c3c0a999f8a185f09f4693c:opam/pretty.opam +# end context for opam/pretty.opam + +# begin context for opam/superbol-free.opam +# file opam/superbol-free.opam +09da22a50ff0d10a1b21364bc27aa345:opam/superbol-free.opam +# end context for opam/superbol-free.opam + # begin context for opam/superbol-vscode-extension.opam # file opam/superbol-vscode-extension.opam 38d272283b51b83690fa806b0868b764:opam/superbol-vscode-extension.opam @@ -113,6 +178,11 @@ dcf0ebaa8b12787df9efcaa0ce8cbbe5:opam/package-json.opam f4782070d6b32d738ffc3d5435fc879a:opam/superbol-vscode-platform.opam # end context for opam/superbol-vscode-platform.opam +# begin context for opam/superbol_free_lib.opam +# file opam/superbol_free_lib.opam +e618a6aa0b5f55717ae192be2c854b0f:opam/superbol_free_lib.opam +# end context for opam/superbol_free_lib.opam + # begin context for opam/vscode-debugadapter.opam # file opam/vscode-debugadapter.opam 49375af72a2ef6a3a464bc88553f1043:opam/vscode-debugadapter.opam @@ -175,17 +245,17 @@ a4431c32911b7499fbdc49e2e62932d2:sphinx/about.rst # begin context for sphinx/conf.py # file sphinx/conf.py -76061a2f78a52ceeb831977de515cb7a:sphinx/conf.py +0f6a35278b93d5d9ceca6431677766e6:sphinx/conf.py # end context for sphinx/conf.py # begin context for sphinx/index.rst # file sphinx/index.rst -eb3deffe184887e5ee0b897028c0f969:sphinx/index.rst +15f9d714c36b467b4d6bb3eb5bf3ebbb:sphinx/index.rst # end context for sphinx/index.rst # begin context for sphinx/install.rst # file sphinx/install.rst -721a43bc2478aef9660f49fd0d2def12:sphinx/install.rst +e26cbe1b90e78660bd7f93418551c1a1:sphinx/install.rst # end context for sphinx/install.rst # begin context for sphinx/license.rst @@ -193,162 +263,252 @@ eb3deffe184887e5ee0b897028c0f969:sphinx/index.rst f4bbb4a41a8b3b39f19a4fc62a5f4841:sphinx/license.rst # end context for sphinx/license.rst -# begin context for src/interop-js-stubs/dune -# file src/interop-js-stubs/dune -707a0383f1e544fb37662db29a4f14ad:src/interop-js-stubs/dune -# end context for src/interop-js-stubs/dune - -# begin context for src/interop-js-stubs/package.toml -# file src/interop-js-stubs/package.toml -cbce59b282479c51946165a86e98583e:src/interop-js-stubs/package.toml -# end context for src/interop-js-stubs/package.toml - -# begin context for src/interop-js-stubs/version.mlt -# file src/interop-js-stubs/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/interop-js-stubs/version.mlt -# end context for src/interop-js-stubs/version.mlt - -# begin context for src/node-js-stubs/dune -# file src/node-js-stubs/dune -cf30d5557250e864c9020afd9e2389fd:src/node-js-stubs/dune -# end context for src/node-js-stubs/dune - -# begin context for src/node-js-stubs/package.toml -# file src/node-js-stubs/package.toml -09a788f8a36173eefb4ea91caf00a4ec:src/node-js-stubs/package.toml -# end context for src/node-js-stubs/package.toml - -# begin context for src/node-js-stubs/version.mlt -# file src/node-js-stubs/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/node-js-stubs/version.mlt -# end context for src/node-js-stubs/version.mlt - -# begin context for src/polka-js-stubs/dune -# file src/polka-js-stubs/dune -569424afbc851a410f6f388591417035:src/polka-js-stubs/dune -# end context for src/polka-js-stubs/dune - -# begin context for src/polka-js-stubs/package.toml -# file src/polka-js-stubs/package.toml -a7d6afd419b3a2cc0b4b8c9df2a8e70c:src/polka-js-stubs/package.toml -# end context for src/polka-js-stubs/package.toml - -# begin context for src/polka-js-stubs/version.mlt -# file src/polka-js-stubs/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/polka-js-stubs/version.mlt -# end context for src/polka-js-stubs/version.mlt - -# begin context for src/superbol-vscode-platform/dune -# file src/superbol-vscode-platform/dune -f336ca790e61d4cc6371e8501b902bbd:src/superbol-vscode-platform/dune -# end context for src/superbol-vscode-platform/dune - -# begin context for src/superbol-vscode-platform/package.toml -# file src/superbol-vscode-platform/package.toml -52a57c098d260447652f7f0beb2872bc:src/superbol-vscode-platform/package.toml -# end context for src/superbol-vscode-platform/package.toml - -# begin context for src/superbol-vscode-platform/version.mlt -# file src/superbol-vscode-platform/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/superbol-vscode-platform/version.mlt -# end context for src/superbol-vscode-platform/version.mlt - -# begin context for src/vscode-debugadapter/dune -# file src/vscode-debugadapter/dune -12ae4bbbcdd1df098363da163e1cbe4e:src/vscode-debugadapter/dune -# end context for src/vscode-debugadapter/dune - -# begin context for src/vscode-debugadapter/package.toml -# file src/vscode-debugadapter/package.toml -dc0d8943797599850bd0180ffadaadaa:src/vscode-debugadapter/package.toml -# end context for src/vscode-debugadapter/package.toml - -# begin context for src/vscode-debugadapter/version.mlt -# file src/vscode-debugadapter/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/vscode-debugadapter/version.mlt -# end context for src/vscode-debugadapter/version.mlt - -# begin context for src/vscode-debugprotocol/dune -# file src/vscode-debugprotocol/dune -20bb8bb628d36d6baca51f4a9f54c8f7:src/vscode-debugprotocol/dune -# end context for src/vscode-debugprotocol/dune - -# begin context for src/vscode-debugprotocol/package.toml -# file src/vscode-debugprotocol/package.toml -f14b34b55e33de7475b9c54938fec6d7:src/vscode-debugprotocol/package.toml -# end context for src/vscode-debugprotocol/package.toml - -# begin context for src/vscode-debugprotocol/version.mlt -# file src/vscode-debugprotocol/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/vscode-debugprotocol/version.mlt -# end context for src/vscode-debugprotocol/version.mlt - -# begin context for src/vscode-js-stubs/dune -# file src/vscode-js-stubs/dune -f8e015ab8ad6d1dc7c7c8d63c86e446d:src/vscode-js-stubs/dune -# end context for src/vscode-js-stubs/dune - -# begin context for src/vscode-js-stubs/package.toml -# file src/vscode-js-stubs/package.toml -ebc05174a1892c2e98fe8aee174b5cb9:src/vscode-js-stubs/package.toml -# end context for src/vscode-js-stubs/package.toml - -# begin context for src/vscode-js-stubs/version.mlt -# file src/vscode-js-stubs/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/vscode-js-stubs/version.mlt -# end context for src/vscode-js-stubs/version.mlt - -# begin context for src/vscode-json/dune -# file src/vscode-json/dune -a18d965350ea19e9be91b3784887f1ef:src/vscode-json/dune -# end context for src/vscode-json/dune - -# begin context for src/vscode-json/index.mld -# file src/vscode-json/index.mld -14bb358dfa3587175fe0ee1a39d81977:src/vscode-json/index.mld -# end context for src/vscode-json/index.mld - -# begin context for src/vscode-json/package.toml -# file src/vscode-json/package.toml -9b831fff3824e035b2d9ef1696f89361:src/vscode-json/package.toml -# end context for src/vscode-json/package.toml - -# begin context for src/vscode-json/version.mlt -# file src/vscode-json/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/vscode-json/version.mlt -# end context for src/vscode-json/version.mlt - -# begin context for src/vscode-languageclient-js-stubs/dune -# file src/vscode-languageclient-js-stubs/dune -935c7469b455b26a8ec1f08627aae863:src/vscode-languageclient-js-stubs/dune -# end context for src/vscode-languageclient-js-stubs/dune - -# begin context for src/vscode-languageclient-js-stubs/package.toml -# file src/vscode-languageclient-js-stubs/package.toml -553168fe21b0362e0d450c5de7f4216e:src/vscode-languageclient-js-stubs/package.toml -# end context for src/vscode-languageclient-js-stubs/package.toml - -# begin context for src/vscode-languageclient-js-stubs/version.mlt -# file src/vscode-languageclient-js-stubs/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/vscode-languageclient-js-stubs/version.mlt -# end context for src/vscode-languageclient-js-stubs/version.mlt - -# begin context for src/vscode-package-json/dune -# file src/vscode-package-json/dune -1418db38f60b30eacfab7a22d0cc2ad7:src/vscode-package-json/dune -# end context for src/vscode-package-json/dune - -# begin context for src/vscode-package-json/linking_flags.sh -# file src/vscode-package-json/linking_flags.sh -9fdfca3cc53df639758ff04fe09d3243:src/vscode-package-json/linking_flags.sh -# end context for src/vscode-package-json/linking_flags.sh - -# begin context for src/vscode-package-json/package.toml -# file src/vscode-package-json/package.toml -4b3c04a3df2a4be1259088d71bc55846:src/vscode-package-json/package.toml -# end context for src/vscode-package-json/package.toml - -# begin context for src/vscode-package-json/version.mlt -# file src/vscode-package-json/version.mlt -940d29cde7f16cd0916ed1d5f9c41154:src/vscode-package-json/version.mlt -# end context for src/vscode-package-json/version.mlt +# begin context for src/lsp/cobol_ast/dune +# file src/lsp/cobol_ast/dune +066a301d0d3a2cc4f1f8eea6e9b48a7f:src/lsp/cobol_ast/dune +# end context for src/lsp/cobol_ast/dune + +# begin context for src/lsp/cobol_ast/version.mlt +# file src/lsp/cobol_ast/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_ast/version.mlt +# end context for src/lsp/cobol_ast/version.mlt + +# begin context for src/lsp/cobol_common/dune +# file src/lsp/cobol_common/dune +85e200450b66aa3e32a935a09370eeee:src/lsp/cobol_common/dune +# end context for src/lsp/cobol_common/dune + +# begin context for src/lsp/cobol_common/version.mlt +# file src/lsp/cobol_common/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_common/version.mlt +# end context for src/lsp/cobol_common/version.mlt + +# begin context for src/lsp/cobol_config/dune +# file src/lsp/cobol_config/dune +631869db8237af96d5ff71c2c8209654:src/lsp/cobol_config/dune +# end context for src/lsp/cobol_config/dune + +# begin context for src/lsp/cobol_config/version.mlt +# file src/lsp/cobol_config/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_config/version.mlt +# end context for src/lsp/cobol_config/version.mlt + +# begin context for src/lsp/cobol_data/dune +# file src/lsp/cobol_data/dune +81bbf8b89cb2c2065539f6c083343849:src/lsp/cobol_data/dune +# end context for src/lsp/cobol_data/dune + +# begin context for src/lsp/cobol_data/version.mlt +# file src/lsp/cobol_data/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_data/version.mlt +# end context for src/lsp/cobol_data/version.mlt + +# begin context for src/lsp/cobol_indent/dune +# file src/lsp/cobol_indent/dune +206291029ab9b39c62663475e37e57cd:src/lsp/cobol_indent/dune +# end context for src/lsp/cobol_indent/dune + +# begin context for src/lsp/cobol_indent/version.mlt +# file src/lsp/cobol_indent/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_indent/version.mlt +# end context for src/lsp/cobol_indent/version.mlt + +# begin context for src/lsp/cobol_lsp/dune +# file src/lsp/cobol_lsp/dune +957f078deb602f8e0114c8abcc771abf:src/lsp/cobol_lsp/dune +# end context for src/lsp/cobol_lsp/dune + +# begin context for src/lsp/cobol_lsp/version.mlt +# file src/lsp/cobol_lsp/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_lsp/version.mlt +# end context for src/lsp/cobol_lsp/version.mlt + +# begin context for src/lsp/cobol_parser/dune +# file src/lsp/cobol_parser/dune +b68ae0e16fe9fde7a4b6b03d84be2680:src/lsp/cobol_parser/dune +# end context for src/lsp/cobol_parser/dune + +# begin context for src/lsp/cobol_parser/version.mlt +# file src/lsp/cobol_parser/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_parser/version.mlt +# end context for src/lsp/cobol_parser/version.mlt + +# begin context for src/lsp/cobol_preproc/dune +# file src/lsp/cobol_preproc/dune +801b4cd6ad70e6c633b48431afb67519:src/lsp/cobol_preproc/dune +# end context for src/lsp/cobol_preproc/dune + +# begin context for src/lsp/cobol_preproc/version.mlt +# file src/lsp/cobol_preproc/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_preproc/version.mlt +# end context for src/lsp/cobol_preproc/version.mlt + +# begin context for src/lsp/cobol_typeck/dune +# file src/lsp/cobol_typeck/dune +bb6994bfe27f29a441abee11c82b032f:src/lsp/cobol_typeck/dune +# end context for src/lsp/cobol_typeck/dune + +# begin context for src/lsp/cobol_typeck/version.mlt +# file src/lsp/cobol_typeck/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/cobol_typeck/version.mlt +# end context for src/lsp/cobol_typeck/version.mlt + +# begin context for src/lsp/ebcdic_lib/dune +# file src/lsp/ebcdic_lib/dune +963d41cf5fce1985fce4ba6f43244817:src/lsp/ebcdic_lib/dune +# end context for src/lsp/ebcdic_lib/dune + +# begin context for src/lsp/ebcdic_lib/ebcdic_version.mlt +# file src/lsp/ebcdic_lib/ebcdic_version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/ebcdic_lib/ebcdic_version.mlt +# end context for src/lsp/ebcdic_lib/ebcdic_version.mlt + +# begin context for src/lsp/ppx_cobcflags/dune +# file src/lsp/ppx_cobcflags/dune +86758f07c1c4f6bef04e0520a41cb8f6:src/lsp/ppx_cobcflags/dune +# end context for src/lsp/ppx_cobcflags/dune + +# begin context for src/lsp/ppx_cobcflags/version.mlt +# file src/lsp/ppx_cobcflags/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/ppx_cobcflags/version.mlt +# end context for src/lsp/ppx_cobcflags/version.mlt + +# begin context for src/lsp/pretty/dune +# file src/lsp/pretty/dune +99a706a3180a431ed103230d66dd9013:src/lsp/pretty/dune +# end context for src/lsp/pretty/dune + +# begin context for src/lsp/pretty/version.mlt +# file src/lsp/pretty/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/pretty/version.mlt +# end context for src/lsp/pretty/version.mlt + +# begin context for src/lsp/superbol-free/dune +# file src/lsp/superbol-free/dune +095155be06e2840753e52b3d03d541b9:src/lsp/superbol-free/dune +# end context for src/lsp/superbol-free/dune + +# begin context for src/lsp/superbol-free/linking_flags.sh +# file src/lsp/superbol-free/linking_flags.sh +b9a14c96cce8e365e1d7494d078d73fe:src/lsp/superbol-free/linking_flags.sh +# end context for src/lsp/superbol-free/linking_flags.sh + +# begin context for src/lsp/superbol_free_lib/dune +# file src/lsp/superbol_free_lib/dune +6625329103c4f2ffacd92354431cce4e:src/lsp/superbol_free_lib/dune +# end context for src/lsp/superbol_free_lib/dune + +# begin context for src/lsp/superbol_free_lib/version.mlt +# file src/lsp/superbol_free_lib/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/lsp/superbol_free_lib/version.mlt +# end context for src/lsp/superbol_free_lib/version.mlt + +# begin context for src/vscode/interop-js-stubs/dune +# file src/vscode/interop-js-stubs/dune +707a0383f1e544fb37662db29a4f14ad:src/vscode/interop-js-stubs/dune +# end context for src/vscode/interop-js-stubs/dune + +# begin context for src/vscode/interop-js-stubs/version.mlt +# file src/vscode/interop-js-stubs/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/interop-js-stubs/version.mlt +# end context for src/vscode/interop-js-stubs/version.mlt + +# begin context for src/vscode/node-js-stubs/dune +# file src/vscode/node-js-stubs/dune +cf30d5557250e864c9020afd9e2389fd:src/vscode/node-js-stubs/dune +# end context for src/vscode/node-js-stubs/dune + +# begin context for src/vscode/node-js-stubs/version.mlt +# file src/vscode/node-js-stubs/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/node-js-stubs/version.mlt +# end context for src/vscode/node-js-stubs/version.mlt + +# begin context for src/vscode/polka-js-stubs/dune +# file src/vscode/polka-js-stubs/dune +569424afbc851a410f6f388591417035:src/vscode/polka-js-stubs/dune +# end context for src/vscode/polka-js-stubs/dune + +# begin context for src/vscode/polka-js-stubs/version.mlt +# file src/vscode/polka-js-stubs/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/polka-js-stubs/version.mlt +# end context for src/vscode/polka-js-stubs/version.mlt + +# begin context for src/vscode/superbol-vscode-platform/dune +# file src/vscode/superbol-vscode-platform/dune +f336ca790e61d4cc6371e8501b902bbd:src/vscode/superbol-vscode-platform/dune +# end context for src/vscode/superbol-vscode-platform/dune + +# begin context for src/vscode/superbol-vscode-platform/version.mlt +# file src/vscode/superbol-vscode-platform/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/superbol-vscode-platform/version.mlt +# end context for src/vscode/superbol-vscode-platform/version.mlt + +# begin context for src/vscode/vscode-debugadapter/dune +# file src/vscode/vscode-debugadapter/dune +12ae4bbbcdd1df098363da163e1cbe4e:src/vscode/vscode-debugadapter/dune +# end context for src/vscode/vscode-debugadapter/dune + +# begin context for src/vscode/vscode-debugadapter/version.mlt +# file src/vscode/vscode-debugadapter/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/vscode-debugadapter/version.mlt +# end context for src/vscode/vscode-debugadapter/version.mlt + +# begin context for src/vscode/vscode-debugprotocol/dune +# file src/vscode/vscode-debugprotocol/dune +20bb8bb628d36d6baca51f4a9f54c8f7:src/vscode/vscode-debugprotocol/dune +# end context for src/vscode/vscode-debugprotocol/dune + +# begin context for src/vscode/vscode-debugprotocol/version.mlt +# file src/vscode/vscode-debugprotocol/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/vscode-debugprotocol/version.mlt +# end context for src/vscode/vscode-debugprotocol/version.mlt + +# begin context for src/vscode/vscode-js-stubs/dune +# file src/vscode/vscode-js-stubs/dune +f8e015ab8ad6d1dc7c7c8d63c86e446d:src/vscode/vscode-js-stubs/dune +# end context for src/vscode/vscode-js-stubs/dune + +# begin context for src/vscode/vscode-js-stubs/version.mlt +# file src/vscode/vscode-js-stubs/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/vscode-js-stubs/version.mlt +# end context for src/vscode/vscode-js-stubs/version.mlt + +# begin context for src/vscode/vscode-json/dune +# file src/vscode/vscode-json/dune +a18d965350ea19e9be91b3784887f1ef:src/vscode/vscode-json/dune +# end context for src/vscode/vscode-json/dune + +# begin context for src/vscode/vscode-json/index.mld +# file src/vscode/vscode-json/index.mld +14bb358dfa3587175fe0ee1a39d81977:src/vscode/vscode-json/index.mld +# end context for src/vscode/vscode-json/index.mld + +# begin context for src/vscode/vscode-json/version.mlt +# file src/vscode/vscode-json/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/vscode-json/version.mlt +# end context for src/vscode/vscode-json/version.mlt + +# begin context for src/vscode/vscode-languageclient-js-stubs/dune +# file src/vscode/vscode-languageclient-js-stubs/dune +935c7469b455b26a8ec1f08627aae863:src/vscode/vscode-languageclient-js-stubs/dune +# end context for src/vscode/vscode-languageclient-js-stubs/dune + +# begin context for src/vscode/vscode-languageclient-js-stubs/version.mlt +# file src/vscode/vscode-languageclient-js-stubs/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/vscode-languageclient-js-stubs/version.mlt +# end context for src/vscode/vscode-languageclient-js-stubs/version.mlt + +# begin context for src/vscode/vscode-package-json/dune +# file src/vscode/vscode-package-json/dune +1418db38f60b30eacfab7a22d0cc2ad7:src/vscode/vscode-package-json/dune +# end context for src/vscode/vscode-package-json/dune + +# begin context for src/vscode/vscode-package-json/linking_flags.sh +# file src/vscode/vscode-package-json/linking_flags.sh +9fdfca3cc53df639758ff04fe09d3243:src/vscode/vscode-package-json/linking_flags.sh +# end context for src/vscode/vscode-package-json/linking_flags.sh + +# begin context for src/vscode/vscode-package-json/version.mlt +# file src/vscode/vscode-package-json/version.mlt +940d29cde7f16cd0916ed1d5f9c41154:src/vscode/vscode-package-json/version.mlt +# end context for src/vscode/vscode-package-json/version.mlt diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index ed8f9f31c..fe0881699 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -17,7 +17,6 @@ jobs: os: - ubuntu-latest - macos-latest - - windows-latest ocaml-compiler: - 4.13.0 skip_test: @@ -41,22 +40,12 @@ jobs: # restore-keys: | # v2-${{ runner.os }}-opam-${{ matrix.ocaml-compiler }}- - - name: Set-up OCaml on Windows - uses: ocaml/setup-ocaml@v2 - if: runner.os == 'Windows' + - name: Use OCaml ${{ matrix.ocaml-compiler }} + uses: avsm/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-repositories: | - opam-repository-mingw: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset - default: https://github.com/ocaml/opam-repository.git - - - name: Set-up OCaml on Unix - uses: ocaml/setup-ocaml@v2 - if: runner.os != 'Windows' - with: - ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-repositories: | - default: https://github.com/ocaml/opam-repository.git + opam-pin: false + opam-depext: false - name: Set git user run: | @@ -67,8 +56,7 @@ jobs: - run: opam pin add . -y --no-action - - run: opam depext -y superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-package-json vscode-json vscode-debugadapter vscode-debugprotocol - if: matrix.os != 'windows-latest' + - run: opam depext -y superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-package-json vscode-json vscode-debugadapter vscode-debugprotocol superbol-free superbol_free_lib cobol_common cobol_parser ebcdic_lib cobol_lsp ppx_cobcflags pretty cobol_config cobol_ast cobol_indent cobol_preproc cobol_data cobol_typeck # if: steps.cache-opam.outputs.cache-hit != 'true' - run: opam install -y opam/*.opam --deps-only --with-test @@ -83,6 +71,11 @@ jobs: # Use fields.github-workflow-before-build to add something here + - run: git submodule init + + - run: git submodule update + + - run: make build # Use fields.github-workflow-after-build to add something here diff --git a/.gitignore b/.gitignore index 6797b6a9f..22a1578ec 100644 --- a/.gitignore +++ b/.gitignore @@ -8,6 +8,7 @@ /vscode-json /vscode-debugadapter /vscode-debugprotocol +/superbol-free *~ _build .merlin diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..cf359a81c --- /dev/null +++ b/.gitmodules @@ -0,0 +1,6 @@ +[submodule "import/gnucobol"] + path = import/gnucobol + url = https://github.com/OcamlPro/gnucobol.git +[submodule "import/merlin"] + path = import/merlin + url = https://github.com/nberth/merlin.git diff --git a/LICENSE.md b/LICENSE.md index a38392480..87d947048 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,3 +1,681 @@ +# Licenses + +The sources in this project are distributed: + +* Under the terms of the GNU Affero GPL License v3 for files in the + src/ directory. The corresponding binary is `superbol-free` that + runs the LSP server; + +* Under the terms of the MIT License for all other files, in + particular the Vscode extension; + +## Affero GPL License v3 + + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +. + + +## MIT License + Copyright (c) 2023 OCamlPro SAS Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: @@ -6,3 +684,23 @@ The above copyright notice and this permission notice shall be included in all c THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +## Tooling + +To verify headers, go to `src/lsp` and run: + +``` +header-check --skip-dir ./cobol_parser/recover --skip-dir ./cobol_parser/printer +``` + +In 2023, the expected header with AGPL License should be +00ed0c544befe216344817b359162127. + +Use the arguments `--add-default 00ed0c544befe216344817b359162127` and +`--replace-by 00ed0c544befe216344817b359162127 --from XXX`. + +Then, go to `src/vscode` and run: + +In 2023, the expected header with MIT License should be: +7ade9bbb0990f624352994c17e592d0b. + + diff --git a/Makefile b/Makefile index e88fc1d77..c5e7955f6 100644 --- a/Makefile +++ b/Makefile @@ -20,7 +20,7 @@ all: build build: ./scripts/before.sh build opam exec -- dune build @install - ./scripts/copy-bin.sh superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-package-json vscode-json vscode-debugadapter vscode-debugprotocol + ./scripts/copy-bin.sh superbol-vscode-platform polka-js-stubs interop-js-stubs node-js-stubs vscode-js-stubs vscode-languageclient-js-stubs vscode-package-json vscode-json vscode-debugadapter vscode-debugprotocol superbol-free superbol_free_lib cobol_common cobol_parser ebcdic_lib cobol_lsp ppx_cobcflags pretty cobol_config cobol_ast cobol_indent cobol_preproc cobol_data cobol_typeck ./scripts/after.sh build build-deps: diff --git a/Makefile.header b/Makefile.header index c76242a11..bf36bf4df 100644 --- a/Makefile.header +++ b/Makefile.header @@ -1,9 +1,9 @@ PROJECT=superbol_vscode_platform -SRCDIR=src/superbol-vscode-platform +SRCDIR=src/vscode/superbol-vscode-platform compile: opam exec -- dune build - cp -f _build/default/src/vscode-package-json/main.exe vscode-package-json + cp -f _build/default/src/vscode/vscode-package-json/main.exe vscode-package-json yarn esbuild _build/default/$(SRCDIR)/$(PROJECT).bc.js \ --bundle \ --external:vscode \ diff --git a/drom.toml b/drom.toml index bd08436d3..a7a7a986d 100644 --- a/drom.toml +++ b/drom.toml @@ -5,7 +5,7 @@ share-version = "0.9.2" [project] authors = ["Fabrice Le Fessant ", "Emilien Lemaire "] -ci-systems = ["ubuntu-latest", "macos-latest", "windows-latest"] +ci-systems = ["ubuntu-latest", "macos-latest"] copyright = "OCamlPro SAS" edition = "4.13.0" github-organization = "ocamlpro" @@ -33,7 +33,7 @@ of the superbol-vscode-platform OCaml project """ [project] -skip = ["@test", "@ocamlformat", "@ocp-indent", "README.md"] +skip = ["@test", "@ocamlformat", "@ocp-indent", "README.md", "sphinx/about.rst", "LICENSE.md"] # project-wide library dependencies (not for package-specific deps) [dependencies] @@ -51,7 +51,7 @@ for-test = true [project] # dirs to skip while scanning for dune files -skip-dirs = ["node_modules"] +skip-dirs = ["node_modules" ] # dirs to scan for share/ folders (with package names) share-dirs = ["share"] @@ -85,44 +85,109 @@ ATTIC !.vscode/launch.json *.vsix """ +github-workflow-before-build = """ + + - run: git submodule init + + - run: git submodule update + +""" + + +[[package]] +dir = "src/vscode/superbol-vscode-platform" +# edit 'src/vscode/superbol-vscode-platform/package.toml' for package-specific options + +[[package]] +dir = "src/vscode/polka-js-stubs" +# edit 'src/vscode/polka-js-stubs/package.toml' for package-specific options + +[[package]] +dir = "src/vscode/interop-js-stubs" +# edit 'src/vscode/interop-js-stubs/package.toml' for package-specific options + +[[package]] +dir = "src/vscode/node-js-stubs" +# edit 'src/vscode/node-js-stubs/package.toml' for package-specific options + +[[package]] +dir = "src/vscode/vscode-js-stubs" +# edit 'src/vscode/vscode-js-stubs/package.toml' for package-specific options + +[[package]] +dir = "src/vscode/vscode-languageclient-js-stubs" +# edit 'src/vscode/vscode-languageclient-js-stubs/package.toml' for package-specific options [[package]] -dir = "src/superbol-vscode-platform" -# edit 'src/superbol-vscode-platform/package.toml' for package-specific options +dir = "src/vscode/vscode-package-json" +# edit 'src/vscode/vscode-package-json/package.toml' for package-specific options [[package]] -dir = "src/polka-js-stubs" -# edit 'src/polka-js-stubs/package.toml' for package-specific options +dir = "src/vscode/vscode-json" +# edit 'src/vscode/vscode-json/package.toml' for package-specific options [[package]] -dir = "src/interop-js-stubs" -# edit 'src/interop-js-stubs/package.toml' for package-specific options +dir = "src/vscode/vscode-debugadapter" +# edit 'src/vscode/vscode-debugadapter/package.toml' for package-specific options [[package]] -dir = "src/node-js-stubs" -# edit 'src/node-js-stubs/package.toml' for package-specific options +dir = "src/vscode/vscode-debugprotocol" +# edit 'src/vscode/vscode-debugprotocol/package.toml' for package-specific options + + [[package]] -dir = "src/vscode-js-stubs" -# edit 'src/vscode-js-stubs/package.toml' for package-specific options +dir = "src/lsp/superbol-free" +# edit 'src/lsp/superbol/package.toml' for package-specific options [[package]] -dir = "src/vscode-languageclient-js-stubs" -# edit 'src/vscode-languageclient-js-stubs/package.toml' for package-specific options +dir = "src/lsp/superbol_free_lib" +# edit 'src/lsp/superbol_lib/package.toml' for package-specific options [[package]] -dir = "src/vscode-package-json" -# edit 'src/vscode-package-json/package.toml' for package-specific options +dir = "src/lsp/cobol_common" +# edit 'src/lsp/cobol_common/package.toml' for package-specific options [[package]] -dir = "src/vscode-json" -# edit 'src/vscode-json/package.toml' for package-specific options +dir = "src/lsp/cobol_parser" +# edit 'src/lsp/cobol_parser/package.toml' for package-specific options [[package]] -dir = "src/vscode-debugadapter" -# edit 'src/vscode-debugadapter/package.toml' for package-specific options +dir = "src/lsp/ebcdic_lib" +# edit 'src/lsp/ebcdic_lib/package.toml' for package-specific options [[package]] -dir = "src/vscode-debugprotocol" -# edit 'src/vscode-debugprotocol/package.toml' for package-specific options +dir = "src/lsp/cobol_lsp" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options +[[package]] +dir = "src/lsp/ppx_cobcflags" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/pretty" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/cobol_config" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/cobol_ast" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/cobol_indent" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/cobol_preproc" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/cobol_data" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options + +[[package]] +dir = "src/lsp/cobol_typeck" +# edit 'src/lsp/cobol_lsp/package.toml' for package-specific options diff --git a/dune-project b/dune-project index a353645a3..206063178 100644 --- a/dune-project +++ b/dune-project @@ -7,6 +7,7 @@ (generate_opam_files false) (version 0.1.0) (formatting (enabled_for ocaml reason)) +(using menhir 2.0) (package (name superbol-vscode-platform) @@ -198,4 +199,239 @@ ) ) +(package + (name superbol-free) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (superbol_free_lib (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name superbol_free_lib) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ez_file ( >= 0.3 )) + (ez_cmdliner (and (>= 0.3.0) (< 1.0.0))) + (cobol_typeck (= version)) + (cobol_parser (= version)) + (cobol_lsp (= version)) + (cobol_indent (= version)) + (cobol_common (= version)) + (cobol_ast (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_common) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (pretty (= version)) + (ppx_deriving ( >= 5.2.1 )) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_parser) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ppx_deriving ( >= 5.2.1 )) + (menhir ( >= 1.2 )) + (ez_file ( >= 0.3 )) + (ebcdic_lib (= version)) + (cobol_preproc (= version)) + (cobol_common (= version)) + (cobol_ast (= version)) + (menhir ( = 20220210 )) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name ebcdic_lib) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_lsp) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (toml (and (>= 7.1.0) (< 8.0.0))) + (pretty (= version)) + (lsp (and ( >= 1.15 )( < 1.16 ))) + (jsonrpc ( >= 1.15 )) + (cobol_typeck (= version)) + (cobol_parser (= version)) + (cobol_indent (= version)) + (cobol_data (= version)) + (cobol_config (= version)) + (cobol_common (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name ppx_cobcflags) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ppxlib ( >= 0.15 )) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name pretty) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (fmt ( >= 0.9 )) + (ez_file ( >= 0.3 )) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_config) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (pretty (= version)) + (ppx_deriving ( >= 5.2.1 )) + (menhir ( >= 1.2 )) + (cobol_common (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_ast) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ppx_deriving ( >= 5.2.1 )) + (cobol_common (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_indent) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (fmt ( >= 0.9 )) + (cobol_preproc (= version)) + (cobol_common (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_preproc) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ppx_deriving ( >= 5.2.1 )) + (menhir ( >= 1.2 )) + (cobol_config (= version)) + (cobol_common (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_data) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ppx_deriving ( >= 5.2.1 )) + (cobol_parser (= version)) + (cobol_ast (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + +(package + (name cobol_typeck) + (synopsis "The superbol-vscode-platform project") + (description "This is the description\nof the superbol-vscode-platform OCaml project\n") + (depends + (ocaml (>= 4.13.0)) + (ppx_deriving ( >= 5.2.1 )) + (cobol_parser (= version)) + (cobol_data (= version)) + (cobol_common (= version)) + (cobol_ast (= version)) + ppx_inline_test + ppx_expect + odoc + ocamlformat + ) + ) + diff --git a/emacs/README.md b/emacs/README.md new file mode 100644 index 000000000..e57fa0ff7 --- /dev/null +++ b/emacs/README.md @@ -0,0 +1,8 @@ +## Emacs `cobol-mode.el` + +The `cobol-mode.el` in this directory is forked from ELPA, with the +following changes: + +* The indentation function was modified to prevent the insertion of + spaces in the middle of the line being indented + diff --git a/emacs/cobol-mode.el b/emacs/cobol-mode.el new file mode 100644 index 000000000..5415eca3e --- /dev/null +++ b/emacs/cobol-mode.el @@ -0,0 +1,3139 @@ +;;; cobol-mode.el --- Mode for editing COBOL code -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2022 Free Software Foundation, Inc. + +;; Author: Edward Hart +;; Maintainer: Edward Hart +;; Version: 1.1 +;; Created: 9 November 2013 +;; Keywords: languages +;; Package-Requires: ((cl-lib "0.5")) + +;; This program 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. +;; +;; 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 program. If not, see . + +;;; Commentary: + +;; This file should not be confused with Rick Bielawski's cobol-mode.el +;; (http://www.emacswiki.org/emacs/cobol-mode.el), which this mode attempts to +;; supersede. + +;; This COBOL mode features syntax highlighting for most modern COBOL dialects, +;; indentation, code skeletons, rulers and basic formatting functions. +;; Highlighting changes with the code format, which can be specified using the +;; M-x customize menu. + +;;;; Installation: + +;; To install cobol-mode.el, save it to your .emacs.d/ directory and add the +;; following to your .emacs: +;; (autoload 'cobol-mode "cobol-mode" "Major mode for highlighting COBOL files." t nil) + +;; To automatically load cobol-mode.el upon opening COBOL files, add this: +;; (setq auto-mode-alist +;; (append +;; '(("\\.cob\\'" . cobol-mode) +;; ("\\.cbl\\'" . cobol-mode) +;; ("\\.cpy\\'" . cobol-mode)) +;; auto-mode-alist)) + +;; Finally, I strongly suggest installing auto-complete-mode, which makes typing +;; long keywords and variable names a thing of the past. See +;; https://github.com/auto-complete/auto-complete. + +;;;; Known bugs: + +;; * Switching source formats requires M-x customize settings to be changed, +;; saved and cobol-mode to be unloaded then reloaded. +;; * Copying-and-pasting content in fixed-format sometimes results in content +;; being pasted in column 1 and spaces inserted in the middle of it. +;; * The indentation code leaves a lot of trailing whitespace. +;; * Periods on their own line are sometimes indented strangely. +;; * String continuation does not work. + +;;;; Missing features: + +;; * Switch between dialect's reserved word lists via M-x customize (without +;; unloading cobol-mode). +;; * Allow users to modify easily reserved word lists. +;; * Expand copybooks within a buffer. +;; * String continuation (see above). +;; * Allow users to modify start of program-name area. + +;;; News: + +;; - A new submenu for skeletons. +;; - cobol-mode is now orphaned :-( +;; We're looking for a generous soul willing to give it loving care. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) + +(defgroup cobol nil + "Major mode for editing COBOL code." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) + :prefix 'cobol- + :group 'languages) + +(eval-and-compile +(defun cobol--radio-of-list (list) + "Return radio with the elements of LIST as its arguments." + (cons 'radio (mapcar #'(lambda (elt) (list 'const elt)) list))) + +(defun cobol--val-in-list-p (list) + "Return a predicate to check whether a value is in the LIST." + #'(lambda (value) (memq value list)))) + +(defcustom cobol-declaration-clause-indent 40 + "Column to indent data division declaration clauses to." + :type 'integer + :safe #'integerp) + +(eval-and-compile +(defconst cobol-formats + '(fixed-85 fixed-2002 free) + "The accepted values for `cobol-source-format'.") + +(defcustom cobol-source-format 'fixed-85 + "Source format of COBOL source code." + :type (cobol--radio-of-list cobol-formats) + :safe (cobol--val-in-list-p cobol-formats))) + +;; Ruler +;; Code derived from the Emacs fortran.el, rulers from IBM Rational Developer. + +(defcustom cobol-fixed-85-ruler + "----+-*A-1-B--+----2----+----3----+----4----+----5----+----6----+----7--|-+----\n" + "Ruler for COBOL-85-style fixed format code." + :type 'string + :safe #'stringp) + +(defcustom cobol-fixed-2002-ruler + "----+-*--1----+----2----+----3----+----4----+----5----+----6----+----7----+----\n" + "Ruler for COBOL-2002-style fixed format code." + :type 'string + :safe #'stringp) + +(defcustom cobol-free-ruler + "----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----\n" + "Ruler for free format code." + :type 'string + :safe 'stringp) + +(defun cobol-column-ruler () + "Insert a column ruler above the current line until the next keystroke. +The next key typed is executed unless it is SPC." + (interactive) + (momentary-string-display + (cond ((eq cobol-source-format 'fixed-85) + cobol-fixed-85-ruler) + ((eq cobol-source-format 'fixed-2002) + cobol-fixed-2002-ruler) + ((eq cobol-source-format 'free) + cobol-free-ruler)) + (save-excursion + (beginning-of-line) + (if (eq (window-start (selected-window)) + (window-point (selected-window))) + (line-beginning-position 2) + (point))) + nil "Type SPC or any command to erase the ruler.")) + +(defcustom cobol-mode-hook nil + "Hook run by `cobol-mode'." + :type 'hook) + +(defun cobol--remove-strings (l1 l2) + "Return a list of strings in L1 not in L2." + (cl-set-difference l1 l2 :test #'string-equal)) + +(defconst cobol-directives + '("CALL-CONVENTION" + "D" + "DEFINE" + "ELIF" + "ELSE" + "END-EVALUATE" + "END-IF" + "EVALUATE" + "FLAG-02" + "FLAG-85" + "FLAG-NATIVE-ARITHMETIC" + "IF" + "IMP" + "LEAP-SECOND" + "LISTING" + "PAGE" + "PROPAGATE" + "SOURCE" + "TURN" + "WHEN") + "List of COBOL compiler directives.") + +(defconst cobol-verbs-74 + '("GO TO" + "NEXT SENTENCE" + "ACCEPT" + "ADD" + "ALTER" + "CALL" + "CANCEL" + "CLOSE" + "COPY" + "COMPUTE" + "DELETE" + "DISABLE" + "DISPLAY" + "DIVIDE" + "ENABLE" + "ENTER" + "EXIT" + "GENERATE" + "GO" + "IF" + "INITIATE" + "INSPECT" + "MERGE" + "MOVE" + "MULTIPLY" + "OPEN" + "PERFORM" + "READ" + "RECEIVE" + "RELEASE" + "RESET" + "RETURN" + "REWRITE" + "SEARCH" + "SELECT" + "SEND" + "SET" + "SORT" + "START" + "STOP" + "STRING" + "SUBTRACT" + "SUPPRESS" + "TERMINATE" + "UNSTRING" + "USE" + "WRITE")) + +(defconst cobol-verbs-85 + (append cobol-verbs-74 + '("CONTINUE" + "EVALUATE" + "INITIALIZE" + "REPLACE"))) + +(defconst cobol-removed-verbs-2002 + '("ALTER" "ENTER")) + +(defconst cobol-verbs-2002 + (append (cobol--remove-strings cobol-verbs-85 cobol-removed-verbs-2002) + '("ALLOCATE" + "FREE" + "GOBACK" + "INVOKE" + "RAISE" + "RESUME" + "UNLOCK" + "VALIDATE"))) + +(defconst cobol-removed-verbs-2014 + '("DISABLE" + "ENABLE" + "SEND" + "RECEIVE")) + +(defconst cobol-verbs-2014 + (cobol--remove-strings cobol-verbs-2002 + cobol-removed-verbs-2014)) + +(defconst cobol-verbs-extensions + '("DELETE FILE" + "READY TRACE" + "RESET TRACE" + "XML GENERATE" + "XML PARSE" + "ATTACH" + "ALLOW" ; Unisys COBOL-74 + "AWAIT-OPEN" ; Unisys COBOL-74 + "CAUSE" ; Unisys COBOL-74 + "CHAIN" + "CHANGE" ; Unisys COBOL-74 + "COLOR" + "COMMIT" + "CREATE" + "DECLARE" + "DELEGATE" + "DETACH" + "DISALLOW" ; Unisys COBOL-74 + "ENTRY" + "EXAMINE" + "EXEC" + "EXECUTE" + "EXHIBIT" + ;; "LOCK" ; Unisys COBOL-74 ; Treated as keyword + "MODIFY" + "NOTE" + "ON" ; OS/VS Statement ; Keyword <= COBOL-74 + "PROCESS" ; Unisys COBOL-74 + "RESPOND" ; Unisys COBOL-74 + "ROLLBACK" + ;; "RUN" ; Unisys COBOL-74 ; Treated as keyword + "SEEK" ; Unisys COBOL-74 + "SERVICE" + "SYNC" ; <= COBOL-74 + "TRANSFORM" + "TRY" + "WAIT")) + +(defconst cobol-verbs + (append cobol-verbs-2014 + cobol-removed-verbs-2002 + cobol-removed-verbs-2014 + cobol-verbs-extensions) + "List of COBOL verb keywords.") + +(defconst cobol-scope-terminators-85 + '("END-ADD" + "END-CALL" + "END-COMPUTE" + "END-DELETE" + "END-DIVIDE" + "END-EVALUATE" + "END-IF" + "END-MULTIPLY" + "END-PERFORM" + "END-READ" + "END-RECEIVE" + "END-RETURN" + "END-REWRITE" + "END-SEARCH" + "END-START" + "END-STRING" + "END-SUBTRACT" + "END-UNSTRING" + "END-WRITE")) + +(defconst cobol-scope-terminators-2002 + (append cobol-scope-terminators-85 + '("END-ACCEPT" + "END-DISPLAY"))) + +(defconst cobol-removed-scope-terminators-2014 + '("END-RECEIVE")) + +(defconst cobol-scope-terminators-2014 + (cobol--remove-strings cobol-scope-terminators-2002 + cobol-removed-scope-terminators-2014)) + +(defconst cobol-scope-terminators-xml-tr + '("END-OPEN")) + +(defconst cobol-scope-terminators-extensions + '("END-CHAIN" + "END-COLOR" + "END-DELEGATE" + "END-EXEC" + "END-INVOKE" + "END-MODIFY" + "END-MOVE" + "END-SYNC" + "END-TRY" + "END-WAIT" + "END-XML")) + +(defconst cobol-scope-terminators + (append cobol-scope-terminators-2014 + cobol-scope-terminators-xml-tr + cobol-scope-terminators-extensions)) + +(defconst cobol-keywords-74 + '("ACCESS" + "ADVANCING" + "AFTER" + "ALL" + "ALPHABETIC" + "ALSO" + "ALTERNATE" + "AND" + "ARE" + "AREA" + "AREAS" + "ASCENDING" + "ASSIGN" + "AT" + "AUTHOR" + "BEFORE" + "BLANK" + "BLOCK" + "BOTTOM" + "BY" + "CD" + "CF" + "CH" + "CHARACTER" + "CHARACTERS" + "CLOCK-UNITS" + "COBOL" + "CODE" + "CODE-SET" + "COLLATING" + "COLUMN" + "COMMA" + "COMMUNICATION" + "COMP" + "COMPUTATIONAL" + "CONFIGURATION" + "CONTAINS" + "CONTROL" + "CONTROLS" + "CORR" + "CORRESPONDING" + "COUNT" + "CURRENCY" + "DATA" + "DATE" + "DATE-COMPILED" + "DATE-WRITTEN" + "DAY" + "DE" + "DEBUG-CONTENTS" + "DEBUG-ITEM" + "DEBUG-LINE" + "DEBUG-NAME" + "DEBUG-SUB-1" + "DEBUG-SUB-2" + "DEBUG-SUB-3" + "DEBUGGING" + "DECIMAL-POINT" + "DECLARATIVES" + "ENVIRONMENT" + "DELIMITED" + "DELIMITER" + "DEPENDING" + "DESCENDING" + "DESTINATION" + "DETAIL" + "DIVISION" + "DOWN" + "DUPLICATES" + "DYNAMIC" + "EGI" + "ELSE" + "EMI" + "END" + "END-OF-PAGE" + "EOP" + "EQUAL" + "ERROR" + "ESI" + "EVERY" + "EXCEPTION" + "EXTEND" + "FD" + "FILE" + "FILE-CONTROL" + "FILLER" + "FINAL" + "FIRST" + "FOOTING" + "FOR" + "FROM" + "GIVING" + "GREATER" + "GROUP" + "HEADING" + "I-O" + "I-O-CONTROL" + "IDENTIFICATION" + "INDEX" + "INDEXED" + "IN" + "INDICATE" + "INITIAL" + "INPUT" + "INPUT-OUTPUT" + "INSTALLATION" + "INTO" + "INVALID" + "IS" + "JUST" + "JUSTIFIED" + "KEY" + "LABEL" + "LAST" + "LEADING" + "LEFT" + ; LENGTH is treated as an intrinsic function. + "LESS" + "LIMIT" + "LIMITS" + "LINAGE" + "LINAGE-COUNTER" + "LINE" + "LINE-COUNTER" + "LINES" + "LINKAGE" + "LOCK" + "NEXT" + "MEMORY" + "MESSAGE" + "MODE" + "MODULES" + "MULTIPLE" + "NATIVE" + "NEGATIVE" + "NO" + "NOT" + "NUMBER" + "NUMERIC" + "OBJECT-COMPUTER" + "OCCURS" + "OF" + "OFF" + "OMITTED" + ;; "ON" ; OS/VS Statement ; Keyword <= COBOL-74 + "OPTIONAL" + "OR" + "ORGANIZATION" + "OUTPUT" + "OVERFLOW" + "PAGE" + "PAGE-COUNTER" + "PF" + "PH" + "PIC" + "PICTURE" + "PLUS" + "POINTER" + "POSITION" + "POSITIVE" + "PRINTING" + "PROCEDURE" + "PROCEDURES" + "PROCEED" + "PROGRAM" + "PROGRAM-ID" + "QUEUE" + "RANDOM" + "RD" + "RECORD" + "RECORDS" + "REDEFINES" + "REEL" + "REFERENCES" + "RELATIVE" + "REMAINDER" + "REMOVAL" + "RENAMES" + "REPLACING" + "REPORT" + "REPORTING" + "REPORT" + "RERUN" + "RESERVE" + "REVERSED" + "REWIND" + "RF" + "RH" + "RIGHT" + "ROUNDED" + "RUN" + "SAME" + "SD" + "SECTION" + "SECURITY" + "SEGMENT" + "SEGMENT-LIMIT" + "SEND" + "SENTENCE" + "SEPARATE" + "SEQUENCE" + "SEQUENTIAL" + "SIZE" + "SORT-MERGE" + "SOURCE" + "SOURCE-COMPUTER" + "SPECIAL-NAMES" + "STANDARD" + "STANDARD-1" + "STATUS" + "SUB-QUEUE-1" + "SUB-QUEUE-2" + "SUB-QUEUE-3" + "SYMBOLIC" + "SYNCHRONIZED" + "TABLE" + "TALLYING" + "TAPE" + "TERMINAL" + "TEXT" + "THAN" + "THROUGH" + "THRU" + "TIME" + "TIMES" + "TO" + "TOP" + "TRAILING" + "TYPE" + "UNIT" + "UNTIL" + "UP" + "UPON" + "USAGE" + "USING" + "VALUE" + "VALUES" + "VARYING" + "WHEN" + "WITH" + "WORDS" + "WORKING-STORAGE")) + +(defconst cobol-keywords-85 + (append cobol-keywords-74 + '("ALPHABET" + "ALPHABETIC-LOWER" + "ALPHABETIC-UPPER" + "ALPHANUMERIC" + "ALPHANUMERIC-EDITED" + "ANY" + "BINARY" + "CLASS" + "COMMON" + "CONTENT" + "CONVERTING" + "DAY-OF-WEEK" + "EXTERNAL" + "FALSE" + "FUNCTION" + "GLOBAL" + "NUMERIC-EDITED" + "ORDER" + "OTHER" + "PACKED-DECIMAL" + "PADDING" + "PURGE" + "REFERENCE" + "STANDARD-2" + "TEST" + "THEN" + "TRUE"))) + +(defconst cobol-removed-keywords-2002 + '("AUTHOR" + "INSTALLATION" + "DATE-WRITTEN" + "DATE-COMPILED" + "SECURITY" + "MEMORY" + "RERUN" + "MULTIPLE" + "TAPE" + "LABEL" + "REVERSED" + "DEBUG-CONTENTS" + "DEBUG-ITEM" + "DEBUG-LINE" + "DEBUG-NAME" + "DEBUG-SUB-1" + "DEBUG-SUB-2" + "DEBUG-SUB-3")) + +(defconst cobol-keywords-2002 + (append (cobol--remove-strings cobol-keywords-85 + cobol-removed-keywords-2002) + '("ACTIVE-CLASS" + "ADDRESS" + "ALIGNED" + "ANYCASE" + "AS" + "B-AND" + "B-NOT" + "B-OR" + "B-XOR" + "BASED" + "BINARY-CHAR" + "BINARY-DOUBLE" + "BINARY-LONG" + "BINARY-SHORT" + "BIT" + "BOOLEAN" + "CLASS-ID" + "COL" + "COLS" + "COLUMNS" + "CONDITION" + "CONSTANT" + "CRT" + "CURSOR" + "DATA-POINTER" + "DEFAULT" + "EC" + "EO" + "EXCEPTION-OBJECT" + "FACTORY" + "FLOAT-EXTENDED" + "FLOAT-LONG" + "FLOAT-SHORT" + "FORMAT" + "FUNCTION-ID" + "GET" + "GROUP-USAGE" + "INHERITS" + "INTERFACE" + "INTERFACE-ID" + "LAST" + "LOCAL-STORAGE" + "LOCALE" + "METHOD" + "METHOD-ID" + "MINUS" + "NATIONAL" + "NATIONAL-EDITED" + "NESTED" + "OBJECT" + "OBJECT-REFERENCE" + "OPTIONS" + "OVERRIDE" + "PRESENT" + "PROGRAM-POINTER" + "PROPERTY" + "PROTOTYPE" + "RAISING" + "REPOSITORY" + "RETRY" + "RETURNING" + "SCREEN" + "SHARING" + "SOURCES" + "SYSTEM-DEFAULT" + "TYPEDEF" + "UNIVERSAL" + "USER-DEFAULT" + "VAL-STATUS" + "VALID" + "VALIDATE-STATUS"))) + +(defconst cobol-keywords-finalizer-tr + '("AUTO-METHOD")) + +(defconst cobol-keywords-xml-tr + '("DOCUMENT" + "IDENTIFIED" + "VERSION-XML")) + +(defconst cobol-removed-keywords-2014 + '("CD" + "DEBUGGING" + "EGI" + "EMI" + "ESI" + "MESSAGE" + "PADDING" + "PURGE" + "QUEUE" + "SEGMENT" + "SUB-QUEUE-1" + "SUB-QUEUE-2" + "SUB-QUEUE-3" + "TERMINAL" + "TEXT")) + +(defconst cobol-keywords-2014 + (append (cobol--remove-strings cobol-keywords-2002 + cobol-removed-keywords-2014) + '("FARTHEST-FROM-ZERO" + "FLOAT-BINARY-32" + "FLOAT-BINARY-64" + "FLOAT-BINARY-128" + "FLOAT-DECIMAL-16" + "FLOAT-DECIMAL-34" + "FLOAT-INFINITY" + "FLOAT-NOT-A-NUMBER" + "FLOAT-NOT-A-NUMBER-QUIET" + "FLOAT-NOT-A-NUMBER-SIGNALING" + "FUNCTION-POINTER" + "IN-ARITHMETIC-RANGE" + "NEAREST-TO-ZERO"))) + +(defconst cobol-keywords-extensions + '("3-D" + "ABSENT" + "ABSTRACT" + "ACQUIRE" + "ACTION" + "ACTIVE-X" + "ACTUAL" + "ACCEPT-CLOSE" + "ACCEPT-OPEN" + "ADDRESS-ARRAY" + "ADDRESS-OFFSET" + "ADJUSTABLE-COLUMNS" + "AFP-5A" + "ALIGNMENT" + "ALLOWING" + "ANY LENGTH" + "APPLY" + "ARGUMENT-NUMBER" + "ARGUMENT-VALUE" + "ASSEMBLY-ATTRIBUTES" + "ASSOCIATED-DATA" ; Unisys + "ASSOCIATED-DATA-LENGTH" ; Unisys + "AUTO-DECIMAL" + "AUTO-HYPHEN-SKIP" + "AUTO-MINIMIZE" + "AUTO-RESIZE" + "AUTO-SKIP" + "AUTO-SPIN" + "AUTOTERMINATE" + "AX-EVENT-LIST" + "B-EXOR" + "B-LEFT" + "B-RIGHT" + "BACKGROUND-COLOUR" + "BACKGROUND-HIGH" + "BACKGROUND-LOW" + "BACKGROUND-STANDARD" + "BACKWARD" + "BAR" + "BASIS" + "BEEP" + "BEGINNING" + "BINARY-INT" + "BINARY-LONG-LONG" + "BIND" + "BITMAP" + "BITMAP-END" + "BITMAP-HANDLE" + "BITMAP-NUMBER" + "BITMAP-RAW-HEIGHT" + "BITMAP-RAW-WIDTH" + "BITMAP-SCALE" + "BITMAP-START" + "BITMAP-TIMER" + "BITMAP-TRAILING" + "BITMAP-WIDTH" + "BLINKING" + "BLOB" + "BLOB-FILE" + "BLOB-LOCATOR" + "BOLD" + "BOX" + "BOXED" + "BROWSING" + "BULK-ADDITION" + "BUSY" + "BUTTONS" + "C01" + "C02" + "C03" + "C04" + "C05" + "C06" + "C07" + "C08" + "C09" + "C10" + "C11" + "C12" + "CALENDAR-FONT" + "CALLED" + "CANCEL-BUTTON" + "CATCH" + "CBL" + "CBL-CTR" + "CCOL" + "CELL" + "CELL-COLOR" + "CELL-DATA" + "CELL-FONT" + "CELL-PROTECTION" + "CELLS" + "CENTERED" + "CENTERED-HEADINGS" + "CENTURY-DATE" + "CENTURY-DAY" + "CHAINING" + "CHANGED" + "CHAR-VARYING" + "CHART" + "CHECK-BOX" + "CHECKING" + "CLASS-ATTRIBUTES" + "CLASS-CONTROL" + "CLASS-OBJECT" + "CLEAR-SELECTION" + "CLINE" + "CLINES" + "CLOB" + "CLOB-FILE" + "CLOB-LOCATOR" + "CLOSE-DISPOSITION" ; Unisys + "CMP" ; Unisys + "COERCION" + "COLORS" + "COLOUR" + "COLOURS" + "COLUMN-COLOR" + "COLUMN-DIVIDERS" + "COLUMN-FONT" + "COLUMN-HEADINGS" + "COLUMN-PROTECTION" + "COM-REG" + "COMBO-BOX" + "COMMAND-LINE" + "COMMITMENT" + "COMP-0" + "COMP-1" + "COMP-2" + "COMP-3" + "COMP-4" + "COMP-5" + "COMP-6" + "COMP-N" + "COMP-X" + "COMPRESSION" + "COMPUTATIONAL-0" + "COMPUTATIONAL-1" + "COMPUTATIONAL-2" + "COMPUTATIONAL-3" + "COMPUTATIONAL-4" + "COMPUTATIONAL-5" + "COMPUTATIONAL-6" + "COMPUTATIONAL-N" + "COMPUTATIONAL-X" + "CONDITION-VALUE" + "CONNECT-TIME-LIMIT" ; Unisys + "CONSOLE" + "CONSTRAIN" + "CONSTRAINTS" + "CONTROL-AREA" + "CONTROL-POINT" ; Unisys + "CONTROLS-UNCROPPED" + "CONVENTION" + "CONVERSION" + "CONVERT" + "COPY-SELECTION" + "CORE-INDEX" + "CP" ; Unisys + "CREATING" + "CRT-UNDER" + "CRUNCH" ; Unisys + "CSIZE" + "CSP" + "CURSOR-COL" + "CURSOR-COLOR" + "CURSOR-FRAME-WIDTH" + "CURSOR-ROW" + "CURSOR-X" + "CURSOR-Y" + "CUSTOM-ATTRIBUTE" + "CUSTOM-PRINT-TEMPLATE" + "CYL-INDEX" + "CYL-OVERFLOW" + "DASHED" + "DATA-COLUMNS" + "DATA-TYPES" + "DATABASE-KEY" + "DATABASE-KEY-LONG" + "DATE-ENTRY" + "DATE-RECORD" + "DBCLOB" + "DBCLOB-FILE" + "DBCLOB-LOCATOR" + "DBCS" + "DEBUG" + "DECIMAL" + "DEFAULT-BUTTON" + "DEFAULT-FONT" + "DEFINITION" + "DELEGATE-ID" + "DESTROY" + "DICTIONARY" + "DISC" + "DISJOINING" + "DISK" + "DISP" + "DISPLAY-1" + "DISPLAY-COLUMNS" + "DISPLAY-FORMAT" + "DISPLAY-ST" + "DIVIDER-COLOR" + "DIVIDERS" + "DONT-PARTICIPATE" ; Unisys + "DOT-DASH" + "DOTTED" + "DOUBLE" + "DRAG-COLOR" + "DRAW" + "DROP" + "DROP-DOWN" + "DROP-LIST" + "EBCDIC" + "ECHO" + "EGCS" + "EJECT" + "ELEMENTARY" + "EMPTY-CHECK" + "ENABLED" + "ENCRYPTION" + "ENDING" + "ENGRAVED" + "ENSURE-VISIBLE" + "ENTRY-FIELD" + "ENTRY-REASON" + "ENUM" + "ENUM-ID" + "ENVIRONMENT-NAME" + "ENVIRONMENT-VALUE" + "EQUALS" + "ESCAPE" + "ESCAPE-BUTTON" + "EVENT" + "EVENT-LIST" + "EVENT-POINTER" + "EXCEEDS" + "EXCEPTION-VALUE" + "EXCESS-3" + "EXCLUDE-EVENT-LIST" + "EXCLUSIVE" + "EXPAND" + "EXTENDED" + "EXTENDED-SEARCH" + "EXTENSION" + "EXTERNAL-FORM" + "EXTERNALLY-DESCRIBED-KEY" + "FH--FCD" + "FH--KEYDEF" + "FILE-ID" + "FILE-LIMIT" + "FILE-LIMITS" + "FILE-NAME" + "FILE-POS" + "FILL-COLOR" + "FILL-COLOR2" + "FILL-PERCENT" + "FINALLY" + "FINISH-REASON" + "FIXED" + "FIXED-FONT" + "FIXED-WIDTH" + "FLAT" + "FLAT-BUTTONS" + "FLOAT" + "FLOATING" + "FONT" + "FOREGROUND-COLOUR" + "FRAME" + "FRAMED" + "FULL-HEIGHT" + "GETTER" + "GO-BACK" + "GO-FORWARD" + "GO-HOME" + "GO-SEARCH" + "GRAPHICAL" + "GRID" + "GRIP" + "GROUP-VALUE" + "HANDLE" + "HAS-CHILDREN" + "HEADING-COLOR" + "HEADING-DIVIDER-COLOR" + "HEADING-FONT" + "HEAVY" + "HEIGHT" + "HEIGHT-IN-CELLS" + "HELP-ID" + "HIDDEN-DATA" + "HIGH" + "HIGH-COLOR" + "HORIZONTAL" + "HOT-TRACK" + "HSCROLL" + "HSCROLL-POS" + "ICON" + "ID" + "IGNORE" + "INDEPENDENT" + "INDEXED" + "INDEXER" + "INDEXER-ID" + "INDIC" + "INDICATOR" + "INDICATORS" + "INDIRECT" + "INHERITING" + "INQUIRE" + "INTERRUPT" + "INSERT" + "INSERT-ROWS" + "INSERTION-INDEX" + "INSTANCE" + "INTERNAL" + "INVOKED" + "ITEM" + "ITEM-BOLD" + "ITEM-ID" + "ITEM-TEXT" + "ITEM-TO-ADD" + "ITEM-TO-DELETE" + "ITEM-TO-EMPTY" + "ITEM-VALUE" + "ITERATOR" + "ITERATOR-ID" + "JOINED" + "JOINING" + "KANJI" + "KEPT" + "KEY-YY" + "KEYBOARD" + "LABEL-OFFSET" + "LARGE-FONT" + "LAST-ROW" + "LAYOUT-DATA" + "LAYOUT-MANAGER" + "LEADING-SHIFT" + "LEAVE" + "LEFT-JUSTIFY" + "LEFT-TEXT" + "LEFTLINE" + "LENGTH-CHECK" + "LENGTH OF" + "LIN" + "LINES-AT-ROOT" + "LINK" + "LIST" + "LIST-BOX" + "LM-RESIZE" + "LANGUAGE" + "LOCAL" ; Unisys + "LOCKING" + "LONG-DATE" + "LONG-VARBINARY" + "LONG-VARCHAR" + "LOW" + "LOW-COLOR" + "LOWER" + "LOWER-BOUND" ; Unisys + "LOWER-BOUNDS" ; Unisys + "LOWERED" + "MASS-UPDATE" + "MASTER-INDEX" + "MAX-HEIGHT" + "MAX-LINES" + "MAX-PROGRESS" + "MAX-SIZE" + "MAX-TEXT" + "MAX-VAL" + "MAX-WIDTH" + "MDI-CHILD" + "MDI-FRAME" + "MEDIUM-FONT" + "MENU" + "MESSAGES" + "METACLASS" + "MIN-HEIGHT" + "MIN-LINES" + "MIN-SIZE" + "MIN-VAL" + "MIN-WIDTH" + "MMDDYYYY" ; Unisys + "MODAL" + "MODELESS" + "MODIFIED" + "MONITOR-POINTER" + "MORE-DATA" ; Unisys + "MORE-LABELS" + "MULTILINE" + "MUTEX-POINTER" + "MYJOB" ; Unisys + "MYSELF" ; Unisys + "NAME" + "NAMED" + "NAVIGATE-URL" + "NCHAR" + "NET-EVENT-LIST" + "NEW" + "NEWABLE" + "NEXT-ITEM" + "NO-AUTO-DEFAULT" + "NO-AUTOSEL" + "NO-BOX" + "NO-CELL-DRAG" + "NO-CLOSE" + "NO-DIVIDERS" + "NO-ECHO" + "NO-F4" + "NO-FOCUS" + "NO-GROUP-TAB" + "NO-KEY-LETTER" + "NO-SEARCH" + "NO-TAB" + "NO-UPDOWN" + "NOMINAL" + "NOTIFY" + "NOTIFY-CHANGE" + "NOTIFY-DBLCLICK" + "NOTIFY-SELCHANGE" + "NSTD-REELS" + "NUM-COL-HEADINGS" + "NUM-ROW-HEADINGS" + "NUM-ROWS" + "NUMERIC-DATE" ; Unisys + "NUMERIC-FILL" + "NUMERIC-TIME" ; Unisys + "O-FILL" + "OBJECT-ID" + "OBJECT-STORAGE" + "OC" ; Unisys + "ODT-INPUT-PRESENT" ; Unisys + "OK-BUTTON" + "OOSTACKPTR" + "OPERATOR" + "OPERATOR-ID" + "OTHERWISE" + "OVERLAP-LEFT" + "OVERLAP-TOP" + "OVERLAPPED" + "OVERLINE" + "OWN" ; Unisys + "PAGE-SETUP" + "PAGE-SIZE" + "PAGED" + "PANEL-INDEX" + "PANEL-STYLE" + "PANEL-TEXT" + "PANEL-WIDTHS" + "PARAMS" + "PARENT" + "PARSE" + "PARTIAL" + "PARTICIPATE" ; Unisys + "PASSWORD" + "PC" ; Unisys + "PERMANENT" + "PIXEL" + "PIXELS" + "PLACEMENT" + "POP-UP" + "POSITION-SHIFT" + "POSITIONING" + "PREFIXING" + "PRINT" + "PRINT-CONTROL" + "PRINT-NO-PROMPT" + "PRINT-PREVIEW" + "PRINT-SWITCH" + "PRINTER" + "PRINTER-1" + "PRIOR" + "PRIORITY" + "PRIVATE" + "PROCEDURE-POINTER" + "PROCESSING" + "PROGRESS" + "PROMPT" + "PROPERTIES" + "PROPERTY-ID" + "PROPERTY-VALUE" + "PROTECTED" + "PUBLIC" + "PUSH-BUTTON" + "QUERY-INDEX" + "RADIO-BUTTON" + "RAISED" + "READ-OK" ; Unisys + "READ-ONLY" + "READING" + "READY" + "REAL" ; Unisys + "RECORD-DATA" + "RECORD-OVERFLOW" + "RECORD-TO-ADD" + "RECORD-TO-DELETE" + "RECORDING" + "REDEFINE" + "REDEFINITION" + "REF" ; Unisys + "REFRESH" + "REGION-COLOR" + "REJECT-OPEN" + "RELOAD" + "REMARKS" + "REORG-CRITERIA" + "REPEATED" + "REREAD" + "RESET" + "RESET-GRID" + "RESET-LIST" + "RESET-TABS" + "RESIDENT" + "RESIZABLE" + "RESTRICTED" + "RESULT-SET-LOCATOR" + "RETURN-CODE" + "RIGHT-ALIGN" + "RIGHT-JUSTIFY" + "RIMMED" + "ROLLING" + "ROW-COLOR" + "ROW-COLOR-PATTERN" + "ROW-DIVIDERS" + "ROW-FONT" + "ROW-HEADINGS" + "ROW-PROTECTION" + "ROWID" + "S01" + "S02" + "S03" + "S04" + "S05" + "SAVE-AS" + "SAVE-AS-NO-PROMPT" + "SCROLL" + "SCROLL-BAR" + "SEARCH-OPTIONS" + "SEARCH-TEXT" + "SELECT-ALL" + "SELECTION-INDEX" + "SELECTION-TEXT" + "SELECTIVE" + "SELF-ACT" + "SELFCLASS" + "SEMAPHORE-POINTER" + "SEPARATION" + "SETTER" + "SHADING" + "SHADOW" + "SHIFT-IN" + "SHIFT-OUT" + "SHORT-DATE" + "SHOW-LINES" + "SHOW-NONE" + "SHOW-SEL-ALWAYS" + ;; SIGN is treated as an intrinsic function. + "SIGNED-INT" + "SIGNED-LONG" + "SIGNED-SHORT" + "SKIP1" + "SKIP2" + "SKIP3" + "SMALL-FONT" + "SORT-CONTROL" + "SORT-CORE-SIZE" + "SORT-FILE-SIZE" + "SORT-MESSAGE" + "SORT-MODE-SIZE" + "SORT-OPTION" + "SORT-ORDER" + "SORT-RETURN" + "SORT-TAPE" + "SORT-TAPES" + "SPACE-FILL" + "SPINNER" + "SQL" + "SQUARE" + "STANDARD-3" + "START-X" + "START-Y" + "STARTING" + "STATIC" + "STATIC-LIST" + "STATIONLIST" + "STATUS-BAR" + "STATUS-TEXT" + "STDCALL" + "STOP-BROWSER" + "STYLE" + "SUBFILE" + "SUBWINDOW" + "SUFFIXING" + ;; SUM is an intrinsic function. + "SW0" + "SW1" + "SW2" + "SW3" + "SW4" + "SW5" + "SW6" + "SW7" + "SW8" + "SW9" + "SW10" + "SW11" + "SW12" + "SW13" + "SW14" + "SW15" + "SWITCH-0" + "SWITCH-1" + "SWITCH-2" + "SWITCH-3" + "SWITCH-4" + "SWITCH-5" + "SWITCH-6" + "SWITCH-7" + "SWITCH-8" + "SWITCH-9" + "SWITCH-10" + "SWITCH-11" + "SWITCH-12" + "SWITCH-13" + "SWITCH-14" + "SWITCH-15" + "SYSIN" + "SYSIPT" + "SYSLST" + "SYSOUT" + "SYSPCH" + "SYSPUNCH" + "SYSTEM" + "SYSTEM-INFO" + "TAB" + "TAB-CONTROL" + "TAB-TO-ADD" + "TAB-TO-DELETE" + "TAG-KEY" ; Unisys + "TAG-SEARCH" ; Unisys + "TALLY" + "TAPES" + "TASK" + "TEMPORARY" + "TERMINAL-INFO" + "TERMINATION-VALUE" + "THREAD" + "THREAD-LOCAL" + "THREAD-LOCAL-STORAGE" + "THREAD-POINTER" + "THUMB-POSITION" + "TILED-HEADINGS" + "TIME-OF-DAY" + "TIME-OUT" + "TIME-RECORD" + "TIMEOUT" + "TIMER" ; Unisys + "TIMESTAMP" + "TIMESTAMP-OFFSET" + "TIMESTAMP-OFFSET-RECORD" + "TIMESTAMP-RECORD" + "TITLE" + "TITLE-BAR" + "TITLE-POSITION" + "TODAYS-DATE" + "TODAYS-NAME" + "TOOL-BAR" + "TOTALED" + "TOTALING" + "TRACE" + "TRACK-AREA" + "TRACK-LIMIT" + "TRACK-THUMB" + "TRACKS" + "TRADITIONAL-FONT" + "TRAILING-SHIFT" + "TRAILING-SIGN" + "TRANSACTION" + "TRANSPARENT" + "TRANSPARENT-COLOR" + "TREE-VIEW" + "UNDERLINED" + "UNEQUAL" + "UNFRAMED" + "UNITS" + "UNSIGNED-INT" + "UNSIGNED-LONG" + "UNSIGNED-SHORT" + "UNSORTED" + "UPDATE" + "UPPER" + "UPSI-0" + "UPSI-1" + "UPSI-2" + "UPSI-3" + "UPSI-4" + "UPSI-5" + "UPSI-6" + "UPSI-7" + "URGENT" + "USE-ALT" + "USE-RETURN" + "USE-TAB" + "USER" + "USER-COLORS" + "USER-GRAY" + "USER-WHITE" + "VA" ; Unisys + "VALUE-FORMAT" + "VALUETYPE" + "VALUETYPE-ID" + "VARBINARY" + "VARIABLE" + "VARIANT" + "VERTICAL" + "VERY-HEAVY" + "VIRTUAL-WIDTH" + "VISIBLE" + "VPADDING" + "VSCROLL" + "VSCROLL-BAR" + "VSCROLL-POS" + "VTOP" + "WEB-BROWSER" + "WHERE" + "WIDTH" + "WIDTH-IN-CELLS" + "WINDOW" + "WRAP" + "WRITE-ONLY" + "WRITE-VERIFY" + "WRITING" + "XML" + "XML-CODE" + "XML-EVENT" + "XML-NTEXT" + "XML-TEXT" + "YIELDING" + "ZERO-FILL")) + +(defvar cobol-keywords + (append cobol-keywords-2014 + cobol-removed-keywords-2002 + cobol-removed-keywords-2014 + cobol-keywords-finalizer-tr + cobol-keywords-xml-tr + cobol-keywords-extensions + cobol-scope-terminators + cobol-removed-scope-terminators-2014) + "List of COBOL keywords.") + +(defconst cobol-context-sensitive-keywords-2002 + '("ARITHMETIC" + "ATTRIBUTE" + "AUTO" + "AUTOMATIC" + "BACKGROUND-COLOR" + "BELL" + "BLINK" + "BYTE-LENGTH" + "CENTER" + "CLASSIFICATION" + "CYCLE" + "EC-ALL" + "EC-ARGUMENT" + "EC-ARGUMENT-FUNCTION" + "EC-ARGUMENT-IMP" + "EC-BOUND" + "EC-BOUND-IMP" + "EC-BOUND-ODO" + "EC-BOUND-OVERFLOW" + "EC-BOUND-PTR" + "EC-BOUND-REF-MOD" + "EC-BOUND-SET" + "EC-BOUND-SUBSCRIPT" + "EC-BOUND-TABLE-LIMIT" + "EC-DATA" + "EC-DATA-CONVERSION" + "EC-DATA-IMP" + "EC-DATA-INCOMPATIBLE" + "EC-DATA-INTEGRITY" + "EC-DATA-PTR-NULL" + "EC-FLOW" + "EC-FLOW-GLOBAL-EXIT" + "EC-FLOW-GLOBAL-GOBACK" + "EC-FLOW-IMP" + "EC-FLOW-RELEASE" + "EC-FLOW-REPORT" + "EC-FLOW-RETURN" + "EC-FLOW-SEARCH" + "EC-FLOW-USE" + "EC-FUNCTION" + "EC-FUNCTION-PTR-INVALID" + "EC-FUNCTION-PTR-NULL" + "EC-I-O" + "EC-I-O-AT-END" + "EC-I-O-EOP" + "EC-I-O-EOP-OVERFLOW" + "EC-I-O-FILE-SHARING" + "EC-I-O-IMP" + "EC-I-O-INVALID-KEY" + "EC-I-O-LINAGE" + "EC-I-O-LOGIC-ERROR" + "EC-I-O-PERMANENT-ERROR" + "EC-I-O-RECORD-OPERATION" + "EC-IMP" + ;; EC-IMP-suffix is matched separately by + ;; cobol-implementor-user-exception-re. + "EC-LOCALE" + "EC-LOCALE-IMP" + "EC-LOCALE-INCOMPATIBLE" + "EC-LOCALE-INVALID" + "EC-LOCALE-INVALID-PTR" + "EC-LOCALE-MISSING" + "EC-LOCALE-SIZE" + "EC-OO" + "EC-OO-CONFORMANCE" + "EC-OO-EXCEPTION" + "EC-OO-IMP" + "EC-OO-METHOD" + "EC-OO-NULL" + "EC-OO-RESOURCE" + "EC-OO-UNIVERSAL" + "EC-ORDER" + "EC-ORDER-IMP" + "EC-ORDER-NOT-SUPPORTED" + "EC-OVERFLOW" + "EC-OVERFLOW-IMP" + "EC-OVERFLOW-STRING" + "EC-OVERFLOW-UNSTRING" + "EC-PROGRAM" + "EC-PROGRAM-ARG-MISMATCH" + "EC-PROGRAM-ARG-OMITTED" + "EC-PROGRAM-CANCEL-ACTIVE" + "EC-PROGRAM-IMP" + "EC-PROGRAM-NOT-FOUND" + "EC-PROGRAM-PTR-NULL" + "EC-PROGRAM-RECURSIVE-CALL" + "EC-PROGRAM-RESOURCES" + "EC-RAISING" + "EC-RAISING-IMP" + "EC-RAISING-NOT-SPECIFIED" + "EC-RANGE" + "EC-RANGE-IMP" + "EC-RANGE-INDEX" + "EC-RANGE-INSPECT-SIZE" + "EC-RANGE-INVALID" + "EC-RANGE-PERFORM-VARYING" + "EC-RANGE-PTR" + "EC-RANGE-SEARCH-INDEX" + "EC-RANGE-SEARCH-NO-MATCH" + "EC-REPORT" + "EC-REPORT-ACTIVE" + "EC-REPORT-COLUMN-OVERLAP" + "EC-REPORT-FILE-MODE" + "EC-REPORT-IMP" + "EC-REPORT-INACTIVE" + "EC-REPORT-LINE-OVERLAP" + "EC-REPORT-NOT-TERMINATED" + "EC-REPORT-PAGE-LIMIT" + "EC-REPORT-PAGE-WIDTH" + "EC-REPORT-SUM-SIZE" + "EC-REPORT-VARYING" + "EC-SCREEN" + "EC-SCREEN-FIELD-OVERLAP" + "EC-SCREEN-IMP" + "EC-SCREEN-ITEM-TRUNCATED" + "EC-SCREEN-LINE-NUMBER" + "EC-SCREEN-STARTING-COLUMN" + "EC-SIZE" + "EC-SIZE-ADDRESS" + "EC-SIZE-EXPONENTIATION" + "EC-SIZE-IMP" + "EC-SIZE-OVERFLOW" + "EC-SIZE-TRUNCATION" + "EC-SIZE-UNDERFLOW" + "EC-SIZE-ZERO-DIVIDE" + "EC-SORT-MERGE" + "EC-SORT-MERGE-ACTIVE" + "EC-SORT-MERGE-FILE-OPEN" + "EC-SORT-MERGE-IMP" + "EC-SORT-MERGE-RELEASE" + "EC-SORT-MERGE-RETURN" + "EC-SORT-MERGE-SEQUENCE" + "EC-STORAGE" + "EC-STORAGE-IMP" + "EC-STORAGE-NOT-ALLOC" + "EC-STORAGE-NOT-AVAIL" + "EC-USER" + ;; EC-USER-suffix is matched separately by + ;; cobol-implementor-user-exception-re. + "EC-VALIDATE" + "EC-VALIDATE-CONTENT" + "EC-VALIDATE-FORMAT" + "EC-VALIDATE-IMP" + "EC-VALIDATE-RELATION" + "EC-VALIDATE-VARYING" + "EOL" + "EOS" + "ENTRY-CONVENTION" + "ERASE" + "EXPANDS" + "FOREGROUND-COLOR" + "FOREVER" + "FULL" + "HIGHLIGHT" + "IGNORING" + "IMPLEMENTS" + "INITIALIZED" + "INTRINSIC" + "LC_ALL" + "LC_COLLATE" + "LC_CTYPE" + "LC_MESSAGES" + "LC_MONETARY" + "LC_NUMERIC" + "LC_TIME" + "LOWLIGHT" + "MANUAL" + "MULTIPLE" ; <= COBOL-74 + "NEGATIVE-INFINITY" + "NONE" + "NORMAL" + "NUMBERS" + "ONLY" + "PARAGRAPH" + "POSITIVE-INFINITY" + "PREVIOUS" + "RECURSIVE" + "RELATION" + "REQUIRED" + "REVERSE-VIDEO" + "SECONDS" + "SECURE" + "STATEMENT" + "STEP" + "STRONG" + "SYMBOL" + "UCS-4" + "UNDERLINE" + "UNSIGNED" + "UTF-8" + "UTF-16" + ;; XML is treated as a reserved word per IBM implementations. + "YYYYDDD" + "YYYYMMDD")) + +(defconst cobol-context-sensitive-keywords-finalizer-tr + '("EC-OO-FINALIZABLE" + "FINALIZER")) + +(defconst cobol-context-sensitive-keywords-xml-tr + '("CHECK" + "DISCARD" + "DOCUMENTATION" + "DTD" + "EC-DATA-INFINITY" + "EC-DATA-NEGATIVE-INFINITY" + "EC-DATA-NOT-A-NUMBER" + "EC-XML" + "EC-XML-CODESET" + "EC-XML-CODESET-CONVERSION" + "EC-XML-COUNT" + "EC-XML-DOCUMENT-TYPE" + "EC-XML-IMPLICIT-CLOSE" + "EC-XML-INVALID" + "EC-XML-NAMESPACE" + "EC-XML-STACKED-OPEN" + "EC-XML-RANGE" + "ELEMENT" + "NAMESPACE" + "RAW" + "SCHEMA" + "STACK" + "VALIDITY")) + +(defconst cobol-context-sensitive-keywords-2014 + (append cobol-context-sensitive-keywords-2002 + '("AWAY-FROM-ZERO" + "BINARY-ENCODING" + "CAPACITY" + "DECIMAL-ENCODING" + "EC-FUNCTION-ARG-OMITTED" + "EC-FUNCTION-NOT-FOUND" + "EC-OO-ARG-OMITTED" + "FLOAT-BINARY" + "FLOAT-DECIMAL" + "HIGH-ORDER-LEFT" + "HIGH-ORDER-RIGHT" + "INTERMEDIATE" + "NEAREST-AWAY-FROM-ZERO" + "NEAREST-EVEN-INTERMEDIATE" + "NEAREST-TOWARD-ZERO" + "PREFIXED" + "PROHIBITED" + "ROUNDING" + "SHORT" + "SIGNED" + "STANDARD-BINARY" + "STANDARD-DECIMAL" + "TOWARD-GREATER" + "TOWARD-LESSER" + "TRUNCATION"))) + +(defconst cobol-context-sensitive-extensions + '("TRUNCATED" ; Unisys + )) + +(defvar cobol-context-sensitive-keywords + (append cobol-context-sensitive-keywords-2014 + cobol-context-sensitive-keywords-finalizer-tr + cobol-context-sensitive-keywords-xml-tr + cobol-context-sensitive-extensions) + "List of context-sensitive COBOL keywords.") + +(defconst cobol-intrinsics-85 + '("ACOS" + "ANNUITY" + "ASIN" + "ATAN" + ;; BYTE-LENGTH is treated as a context-sensitive word. + "CHAR" + "COS" + "CONCATENATE" + "CURRENT-DATE" + "DATE-OF-INTEGER" + "DAY-OF-INTEGER" + "FACTORIAL" + "INTEGER" + "INTEGER-OF-DATE" + "INTEGER-OF-DAY" + "INTEGER-PART" + "LENGTH" + "LOG" + "LOG10" + "LOWER-CASE" + "MAX" + "MEAN" + "MEDIAN" + "MIDRANGE" + "MIN" + "MOD" + "NUMVAL" + "NUMVAL-C" + "ORD" + "ORD-MAX" + "ORD-MIN" + "PRESENT-VALUE" + ;; RANDOM is treated as a keyword + "RANGE" + "REM" + "REVERSE" + "SIGN" ; Keyword <= COBOL-74 + "SIN" + "SQRT" + "STANDARD-DEVIATION" + "SUM" ; Keyword <= COBOL-74 + "TAN" + "UPPER-CASE" + "VARIANCE" + "WHEN-COMPILED")) + +(defconst cobol-intrinsics-2002 + (append cobol-intrinsics-85 + '("ABS" + "BOOLEAN-OF-INTEGER" + "CHAR-NATIONAL" + "DATE-TO-YYYYMMDD" + "DAY-TO-YYYYDDD" + "DISPLAY-OF" + "E" + "EXCEPTION-FILE" + "EXCEPTION-FILE-N" + "EXCEPTION-LOCATION" + "EXCEPTION-LOCATION-N" + "EXCEPTION-STATEMENT" + "EXCEPTION-STATUS" + "EXP" + "EXP10" + "FRACTION-PART" + "HIGHEST-ALGEBRAIC" + "INTEGER-OF-BOOLEAN" + "LOCALE-COMPARE" + "LOCALE-DATE" + "LOCALE-TIME" + "LOWEST-ALGEBRAIC" + "NATIONAL-OF" + "NUMVAL-F" + "PI" + "STANDARD-COMPARE" + "TEST-DATE-YYYYMMDD" + "TEST-DAY-YYYYDDD" + "TEST-NUMVAL" + "TEST-NUMVAL-C" + "TEST-NUMVAL-F" + "YEAR-TO-YYYY"))) + +(defconst cobol-intrinsics-2014 + (append cobol-intrinsics-2002 + '("COMBINED-DATETIME" + "FORMATTED-CURRENT-DATE" + "FORMATTED-DATE" + "FORMATTED-DATETIME" + "FORMATTED-TIME" + "INTEGER-OF-FORMATTED-DATE" + "LOCALE-TIME-FROM-SECONDS" + "SECONDS-FROM-FORMATTED-TIME" + "SECONDS-PAST-MIDNIGHT" + "TEST-FORMATTED-DATETIME" + "TRIM"))) + +(defconst cobol-intrinsics-extensions + '("ADDR" + "CURRENCY-SYMBOL" + "LENGTH-AN" + "MODULE-CALLER-ID" + "MODULE-DATE" + "MODULE-FORMATTED-DATE" + "MODULE-ID" + "MODULE-PATH" + "MODULE-SOURCE" + "MONETARY-DECIMAL-POINT" + "MONETARY-THOUSANDS-SEPARATOR" + "NUMERIC-DECIMAL-POINT" + "NUMERIC-THOUSANDS-SEPARATOR" + "STORED-CHAR-LENGTH" + "SUBSTITUTE" + "SUBSTITUTE-CASE" + "ULENGTH" + "UPOS" + "USUBSTR" + "USUPPLEMENTARY" + "UVALID" + "UWIDTH")) + +(defvar cobol-intrinsics + (append cobol-intrinsics-2014 + cobol-intrinsics-extensions) + "List of COBOL standard functions.") + +(defconst cobol-symbolic-literals-74 + '("HIGH-VALUE" + "HIGH-VALUES" + "LOW-VALUE" + "LOW-VALUES" + "QUOTE" + "QUOTES" + "SPACE" + "SPACES" + "ZERO" + "ZEROES" + "ZEROS")) + +(defconst cobol-symbolic-literals-85 + cobol-symbolic-literals-74) + +(defconst cobol-symbolic-literals-2002 + (append cobol-symbolic-literals-85 + '("NULL" + "SELF" + "SUPER"))) + +(defconst cobol-symbolic-literals-2014 + cobol-symbolic-literals-2002) + +(defconst cobol-symbolic-literals-extensions + '("NULLS")) + +(defvar cobol-symbolic-literals + (append cobol-symbolic-literals-2014 + cobol-symbolic-literals-extensions) + "List of COBOL symbolic literals.") + +(defface cobol-verb + '((t (:inherit font-lock-keyword-face :weight bold))) + "Face for COBOL verbs.") + +(defface cobol-context-sensitive + '((t (:inherit font-lock-keyword-face))) + "Face for context-sensitive COBOL words.") + +;;; Highlighting regexps + +(defconst cobol--fixed-form-sequence-area-re + "^.\\{1,6\\}" + "Regexp matching the fixed-form sequence area.") + +(eval-and-compile +(defconst cobol--complete-sequence-area-re + "^.\\{6\\}" + "Regexp matching a complete sequence area.") + +(defconst cobol--fixed-comment-indicators + "*/" + "String containing COBOL fixed-form comment indicator characters.") + +(defconst cobol--fixed-form-comment-re + (concat cobol--complete-sequence-area-re + "\\([" + cobol--fixed-comment-indicators + "]\\)") + "Regexp matching a fixed-form source comment.") + +(defconst cobol--continuation-or-debugging-indicator-re + (concat cobol--complete-sequence-area-re + "\\([d-]\\)") + "Regexp matching a continuation or debugging line indicator.") + +(defconst cobol--non-fixed-comment-indicators-re + (concat "[^" cobol--fixed-comment-indicators "]") + "Regexp matching non-fixed-form-comment-indicator characters.") + +(defconst cobol--fixed-non-comment-sequence-area-re + (concat cobol--complete-sequence-area-re + cobol--non-fixed-comment-indicators-re) + "Regexp matching the sequence area of a non-comment fixed-form line.")) + +(defconst cobol--fixed-non-comment-grouped-sequence-area-re + (concat "\\(" cobol--fixed-form-sequence-area-re "\\)") + "Regexp matching the sequence area of a non-comment fixed-form line in a +group.") + +(defconst cobol--fixed-form-areas-02-re + cobol--fixed-non-comment-grouped-sequence-area-re + "Regexp matching the ignored fixed-forms area in COBOL 2002 for non-comment +lines.") + +(defconst cobol--fixed-form-areas-85-re + (concat cobol--fixed-non-comment-grouped-sequence-area-re + ".\\{0,66\\}\\(.*\\)") + "Regexp matching the ignored fixed-form areas up to COBOL-85 for non-comment +lines.") + +(defconst cobol--fixed-form-wrong-indicator-re + (concat cobol--fixed-form-sequence-area-re "\\([^-\\*/d$]\\)") + "Regexp matching incorrect indicators in fixed-form code.") + +(defconst cobol--free-form-comment-re + "\\*>.*" + "Regexp matching a free-form source comment.") + +(eval-and-compile +(defconst cobol--optional-whitespace-re + "[ ]*" ; Space and tab + "Regexp matching optional whitespace. +\\w isn't used to avoid matching newlines.") + +(defconst cobol--optional-leading-whitespace-line-re + (if (not (eq cobol-source-format 'free)) + (concat cobol--fixed-non-comment-sequence-area-re + cobol--optional-whitespace-re) + (concat "^" cobol--optional-whitespace-re)) + "Regexp matching a line perhaps starting with whitespace.") + +(defun cobol--with-opt-whitespace-line (&rest strs) + "Return STRS concatenated after `cobol--optional-leading-whitespace-line-re'." + (apply #'concat cobol--optional-leading-whitespace-line-re strs))) + +(defconst cobol--free-form-comment-line-re + (cobol--with-opt-whitespace-line cobol--free-form-comment-re) + "Regexp matching a free form comment line.") + +(defconst cobol--identifier-re + "\\s-+\\(\\w+\\)" + "Regexp matching an identifier in a separate group preceded by whitespace.") + +(defconst cobol--mf-set-directive + (cobol--with-opt-whitespace-line "\\$SET\\s-+\\w+") + "Regexp matching MF compiler directive with optional whitespace.") + +(defconst cobol--mf-compiler-directive-re + (if (not (eq cobol-source-format 'free)) + (concat cobol--fixed-form-sequence-area-re + ;; FIXME: cobol--mf-set-directive starts with "^" so it can't + ;; match after cobol--fixed-form-sequence-area-re! + cobol--mf-set-directive) + (concat "^" cobol--mf-set-directive)) + "Regexp matching Micro Focus compiler directives.") + +(defconst cobol--standard-constant-re + (cobol--with-opt-whitespace-line "0?1" cobol--identifier-re "\\s-+CONSTANT") + "Regexp matching constants declared as specified by the 2002 standard.") + +(defconst cobol--mf-constant-re + (cobol--with-opt-whitespace-line "78" cobol--identifier-re) + "Regexp matching constants declared as specified by Micro Focus.") + +(eval-and-compile +(defconst cobol--directive-indicator-re + ">> ?" + "Regexp matching a valid directive indicator.")) + +(defconst cobol--define-directive-re + (cobol--with-opt-whitespace-line cobol--directive-indicator-re + "DEFINE" + cobol--identifier-re) + "Regexp matching values defined by the pre-processor.") + +(defconst cobol--descriptor-level-re + "[FRS]D" + "Regexp matching file/report/sort descriptor \"level numbers\".") + +(defconst cobol--record-descriptor-re + (cobol--with-opt-whitespace-line cobol--descriptor-level-re cobol--identifier-re) + "Regexp matching file/report/sort record associations.") + +(defconst cobol--typedef-definition-re + (cobol--with-opt-whitespace-line "0?1" cobol--identifier-re ".+TYPEDEF") + "Regexp matching typedefs.") + +(defconst cobol--level-number-re + "[[:digit:]]\\{1,2\\}" + "Regexp matching level numbers.") + +(defconst cobol--variable-declaration-re + (cobol--with-opt-whitespace-line cobol--level-number-re cobol--identifier-re) + "Regexp matching standard variable declarations.") + +(defconst cobol--mf-declare-variable-re + (cobol--with-opt-whitespace-line "DECLARE" cobol--identifier-re) + "Regexp matching variable declarations using DECLARE verb used in Managed +COBOL.") + +(defconst cobol--id-and-name-re + "-ID\\.?\\s-*\\(\\w+\\)" + "Regexp matching a construct ID and the name of the declared construct.") + +(defun cobol--create-id-re (re) + "Create an id regexp using RE." + (cobol--with-opt-whitespace-line re cobol--id-and-name-re)) + +(defun cobol--create-end-marker-re (re) + "Create an end marker regexp using RE." + (cobol--with-opt-whitespace-line "END\\s-+" re cobol--identifier-re)) + +(defconst cobol--standard-function-types + '("FUNCTION" "METHOD" "PROGRAM") + "List containing the names of standard constructs similar to functions.") + +(defconst cobol--mf-function-types + '("ITERATOR" "OPERATOR" "PROPERTY") + "List containing the names of constructs similar to functions created by Micro +Focus.") + +(defconst cobol--function-types-re + (regexp-opt (append cobol--standard-function-types cobol--mf-function-types)) + "Regexp matching the names of constructs similar to functions.") + +(defconst cobol--function-id-name-re + (cobol--create-id-re (remove "PROPERTY" cobol--function-types-re)) + "Regexp matching the id and name of a function or similar.") + +(defconst cobol--function-end-marker-re + (cobol--create-end-marker-re cobol--function-types-re) + "Regexp matching the end marker of a function or similar.") + +(defconst cobol--standard-type-types + '("CLASS" "INTERFACE") + "List containing the standard type construct names.") + +(defconst cobol--mf-type-types + '("DELEGATE" "ENUM" "INDEXER" "VALUETYPE") + "List containing the names of type constructs added by Micro Focus.") + +(defconst cobol--type-types-re + (regexp-opt (append cobol--standard-type-types cobol--mf-type-types)) + "Regexp matching type construct names.") + +(defconst cobol--type-id-name-re + (cobol--create-id-re cobol--type-types-re) + "Regexp matching the id and name of a type.") + +(defconst cobol--type-end-marker-re + (cobol--create-end-marker-re cobol--type-types-re) + "Regexp matching the end marker of a type.") + +(defconst cobol--mf-property-id-name-re + (concat "PROPERTY" cobol--id-and-name-re cobol--identifier-re) + "Regexp matching the id, name and type of a property using MF's PROPERTY-ID +syntax.") + +(defconst cobol--procedure-re + (cobol--with-opt-whitespace-line "\\(\\w+\\)\\(\\s-+SECTION\\)?\\.") + "Regexp matching the declaration of a procedure. +Note that this matches DECLARATIVES.") + +(defconst cobol--select-file-re + (cobol--with-opt-whitespace-line + "SELECT\\(\\s-+OPTIONAL\\)?" + cobol--identifier-re) + "Regexp matching the declaration of a file.") + +(defconst cobol--pic-type-re + "PIC\\(TURE\\)?\\(\\s-+IS\\)?\\s-+\\(\\([-$*+,./[:digit:]()ABENPSVXZ]\\|CR\\|DB\\)+?\\)\\(\\s-\\|\\.? +\\)" + "Regexp matching the PICTURE clause of a variable.") + +(defconst cobol--string-literal-type-re + "\\([ZBN]X?\\|[GHLX]\\)\\(\"\\|\'\\)" + "Regexp matching the type of a string-style literal.") + +(defconst cobol--function-call-re + "\\(\\w+\\)(" + "Regexp matching a function call.") + +(defun cobol--create-specifier-type-re (types) + "Create a specifier id regexp for the list of type names TYPES." + (cobol--with-opt-whitespace-line + "\\(" + (mapconcat #'identity types "\\|") + "\\)" + cobol--identifier-re)) + +(defconst cobol--repository-function-type-clause-re + (cobol--create-specifier-type-re cobol--standard-function-types) + "Regexp matching a REPOSITORY specifier clause for function types.") + +(defconst cobol--repository-type-type-clause-re + (cobol--create-specifier-type-re cobol--standard-type-types) + "Regexp matching a REPOSITORY specifier clause for type types.") + +(defconst cobol--mf-invoked-class-re + (concat "TYPE" cobol--identifier-re) + "Regexp matching a class being INVOKED.") + +(defconst cobol--implementer-user-exception-re + "EC-\\(IMP\\|USER\\)-\\w+" + "Regexp matching an implementor- or user-defined exception condition.") + +(defconst cobol--scope-terminator-re + (cobol--with-opt-whitespace-line (regexp-opt cobol-scope-terminators 'words)) + "Regexp matching a scope terminator.") + +(defconst cobol--phrases-with-double-indent-after + "\\(IF\\|EVALUATE\\|WHEN\\|ELSE\\|PERFORM\\s-+\\(VARYING\\|UNTIL\\|\\(WITH\\s-+\\)?TEST\\|.+?\\s-+TIMES\\)\\)" + "Regexp matching phrases whose conditions/clauses are indented twice.") + +(defconst cobol--containing-statement-or-phrase-re + (cobol--with-opt-whitespace-line + "\\(" + cobol--phrases-with-double-indent-after + "\\|\\(NOT\\s-+\\)?\\(\\(AT\\s-+\\)?END\\(-OF-PAGE\\)?\\>\\|\\(ON\\s-+\\)?\\(OVERFLOW\\|EXCEPTION\\|ESCAPE\\|SIZE\\s-+ERROR\\)\\|INVALID\\s-+KEY\\)\\)") + "Regexp matching statements/phrases that contain nested statements.") + +(defconst cobol--verb-re + (cobol--with-opt-whitespace-line (regexp-opt cobol-verbs 'words)) + "Regexp matching a verb.") + +(defconst cobol--non-id-groups + ;; AUTO-METHOD is part of the Finalizer TR. + '("AUTO-METHOD" "DECLARATIVES" "FACTORY" "OBJECT" "METHOD") + "Groups which do not take a (specifiable) ID.") + +(defconst cobol--non-id-group-end-marker-re + (cobol--with-opt-whitespace-line + "END\\s-+" (regexp-opt cobol--non-id-groups 'words)) + "Regexp matching the end marker of the groups not taking IDs.") + +(defconst cobol--end-marker-re + (concat "\\(" cobol--function-end-marker-re + "\\|" cobol--type-end-marker-re + "\\|" cobol--non-id-group-end-marker-re + "\\)") + "Regexp matching an end marker.") + +(defconst cobol--division-re + (cobol--with-opt-whitespace-line "\\(IDENTIFICATION\\|ENVIRONMENT\\|DATA\\|PROCEDURE\\)\\s-+DIVISION") + "Regexp matching division header.") + +(defconst cobol--procedure-division-re + (cobol--with-opt-whitespace-line "PROCEDURE\\s-+DIVISION") + "Regexp matching the procedure division header.") + +(defconst cobol--env-or-data-div-sections-re + (cobol--with-opt-whitespace-line + (regexp-opt '("CONFIGURATION" "INPUT-OUTPUT" "FILE" "WORKING-STORAGE" "LOCAL-STORAGE" "LINKAGE" "REPORT" "SCREEN")) + "\\s-+SECTION.") + "Regexp matching the sections of the environment and data divisions.") + +(defconst cobol--generic-declaration-re + (cobol--with-opt-whitespace-line + "\\(" + cobol--descriptor-level-re + "\\|" + cobol--level-number-re + "\\)" + cobol--identifier-re) + "Regexp matching any declaration.") + +(defconst cobol--blank-line-re + (cobol--with-opt-whitespace-line "\\.?$") + "Regexp matching a blank line with optional period.") + +;;; Font lock + +(defun cobol--fixed-format-p () + "Return whether the current source format is fixed." + (memq cobol-source-format '(fixed-85 'fixed-2002))) + +;; This is required for indentation to function, because the initial sequence +;; area is marked as a comment, not whitespace. +(defun cobol-back-to-indentation () + "Move point to the first non-whitespace character on this line. +If in fixed-form code, the sequence area and indicators are skipped. +Code copied from the Emacs source." + (interactive "^") + (beginning-of-line 1) + (when (cobol--fixed-format-p) + (forward-char 7)) + (skip-syntax-forward " " (line-end-position)) + ;; Move back over chars that have whitespace syntax but have the p flag. + (backward-prefix-chars)) + +(defun cobol--font-lock-sequence-area (end) + "Mark text in the sequence area as comments from point up to END." + (when (cobol--fixed-format-p) + (while (and (< (point) end) + (re-search-forward "^.\\{1,6\\}" end t)) + (put-text-property (match-beginning 0) (point) + 'face font-lock-comment-face))) + nil) + +(eval-when-compile + (defconst cobol--syntax-propertize-indicator-area + (syntax-propertize-precompile-rules + (cobol--fixed-form-comment-re (1 "<")) + (cobol--continuation-or-debugging-indicator-re (1 "."))) + "Syntax rules to mark fixed-form comments as comments.") + + (defconst cobol--syntax-propertize-program-name-area + (syntax-propertize-precompile-rules + ;; TODO: Override open strings + ("^.\\{72\\}\\(.\\)" (1 "<"))) + "Syntax rule to mark text in the program name area as comments.") + + (defconst cobol--syntax-propertize-page-directive + (syntax-propertize-precompile-rules + ((cobol--with-opt-whitespace-line cobol--directive-indicator-re + "PAGE\\([ ]\\)") + (1 "<"))) + "Syntax rule to mark text after >>PAGE as a comment.") + + (defconst cobol--syntax-propertize-adjacent-quotes + (syntax-propertize-precompile-rules + ("\"\"\\|''" + (0 (ignore + ;; Move to first quote. + (backward-char 2) + (if (nth 3 (syntax-ppss)) + (progn + (put-text-property (point) (1+ (point)) + 'syntax-table (string-to-syntax "\\")) + ;; Move back to past the escaped quotes. + (forward-char 2)) + ;; If the first quote began a string, then the next quote may be the + ;; first character in another escaped quote sequence. + (forward-char 1)))))) + "Syntax rule to mark the first of adjacent quotes. +It marks the first of \"\" or '' as an escape character.")) + +(defun cobol--syntax-propertize-function (beg end) + "Syntax propertize awkward COBOL features (fixed-form comments, indicators +and ignored areas) between points BEG and END." + ;; TO-DO: Propertize continuation lines. + (funcall + (pcase cobol-source-format + (`fixed-85 (syntax-propertize-rules + cobol--syntax-propertize-indicator-area + cobol--syntax-propertize-program-name-area + cobol--syntax-propertize-page-directive + cobol--syntax-propertize-adjacent-quotes)) + (`fixed-2002 (syntax-propertize-rules + cobol--syntax-propertize-indicator-area + cobol--syntax-propertize-page-directive + cobol--syntax-propertize-adjacent-quotes)) + (_ (syntax-propertize-rules + cobol--syntax-propertize-page-directive + cobol--syntax-propertize-adjacent-quotes))) + beg end)) + +;; Change to defconst so it reloads on something? +(defvar cobol-font-lock-defaults + `((;; Sequence area + (cobol--font-lock-sequence-area) + + ;; Directives + ( ,(concat cobol--directive-indicator-re + "\\(" (regexp-opt cobol-directives) "\\>\\)") + . font-lock-preprocessor-face) + ( ,cobol--mf-compiler-directive-re . font-lock-preprocessor-face) + + ;; TO-DO: Highlight reserved words in directives as reserved words + + ;; Standard language features. + ( ,(regexp-opt cobol-verbs 'words) . 'cobol-verb) + ( ,(regexp-opt cobol-keywords 'words) . font-lock-keyword-face) + ( ,(regexp-opt cobol-context-sensitive-keywords 'words) + . 'cobol-context-sensitive) + ( ,cobol--implementer-user-exception-re . 'cobol-context-sensitive) + ( ,(regexp-opt cobol-intrinsics 'words) . font-lock-builtin-face) + + ;; Constants + ( ,(regexp-opt cobol-symbolic-literals 'words) . font-lock-constant-face) + ( ,cobol--standard-constant-re + (1 'font-lock-constant-face)) + ( ,cobol--mf-constant-re + (1 'font-lock-constant-face)) + ( ,cobol--define-directive-re + (1 'font-lock-constant-face)) + + ;; PIC Type + ( ,cobol--pic-type-re + (3 'font-lock-type-face)) + + ;; Functions + ( ,cobol--function-call-re + (1 'font-lock-function-name-face)) + + ;; REPOSITORY clauses + ( ,cobol--repository-function-type-clause-re + (2 'font-lock-function-name-face)) + ( ,cobol--repository-type-type-clause-re + (2 'font-lock-type-face)) + + ;; File declarations + ( ,cobol--select-file-re + (2 'font-lock-type-face)) + + ;; File/Report/Sort record associations + ( ,cobol--record-descriptor-re + (1 'font-lock-type-face)) + + ;; Typedef + ( ,cobol--typedef-definition-re + (1 'font-lock-type-face)) + + ;; Variables + ( ,cobol--variable-declaration-re + (1 'font-lock-variable-name-face)) + ( ,cobol--mf-declare-variable-re + (1 'font-lock-variable-name-face)) + + ;; Construct IDs + ( ,cobol--function-id-name-re + (1 'font-lock-function-name-face)) + ( ,cobol--type-id-name-re + (1 'font-lock-type-face)) + ( ,cobol--mf-property-id-name-re + (1 'font-lock-variable-name-face) + (2 'font-lock-type-face)) + + ;; Construct end markers + ( ,cobol--function-end-marker-re + (1 'font-lock-function-name-face)) + ( ,cobol--type-end-marker-re + (1 'font-lock-type-face)) + + ;; Invoked classes + ( ,cobol--mf-invoked-class-re + (1 'font-lock-type-face)) + + ;; Procedures + ( ,cobol--procedure-re + (1 'font-lock-function-name-face)) + + ( ,cobol--string-literal-type-re + (1 'font-lock-string-face))) + nil + t + nil + nil)) + +;;; Skeletons + +(defvar cobol-skeleton-alist nil + "Alist of code templates. +You can extend this alist to your heart's content. For each additional +template NAME in the list, declare a keyboard macro or function (or +interactive command) called `cobol-skeleton-NAME'. +If `cobol-skeleton-NAME' is a function it takes no arguments and should +insert the template at point; if this is a command it may accept any +sensible interactive call arguments; keyboard macros can't take +arguments at all.") + + +(defmacro cobol--def-skeleton (name doc interactor &rest elements) + (declare (indent 1) (doc-string 2)) + (let ((fsym (intern (concat "cobol-skeleton-" name))) + (printname (replace-regexp-in-string "-" " " (upcase name)))) + `(progn + (add-to-list 'cobol-skeleton-alist ',(cons printname fsym)) + ;; (define-abbrev sml-skel-abbrev-table ,name "" ',fsym :system t) + (define-skeleton ,fsym + ,doc + ,interactor + ,@elements)))) + +(defun cobol-skeleton--menu (_menu) + (mapcar (lambda (x) (vector (car x) (cdr x) t)) + cobol-skeleton-alist)) + +(cobol--def-skeleton "if-else" + "Insert an IF - ELSE - END-IF block." nil + > "IF " (skeleton-read "Condition: ") > \n + > _ \n + "ELSE" > \n + > \n + "END-IF" > \n) + +(cobol--def-skeleton "if" + "Insert an IF - END-IF block." nil + > "IF " (skeleton-read "Condition: ") > \n + > _ \n + "END-IF" > \n) + +(cobol--def-skeleton "perform-times" + "Insert a PERFORM - TIMES - END-PERFORM block." nil + > "PERFORM " (skeleton-read "Number: ") " TIMES" > \n + > _ \n + "END-PERFORM" > \n) + +(cobol--def-skeleton "perform-varying" + "Insert a PERFORM VARYING - FROM - BY - UNTIL - END-PERFORM block." + nil + > "PERFORM VARYING " + (skeleton-read "Variable: ") + " FROM " + (skeleton-read "Start: ") + " BY " + (skeleton-read "Step: ") + " UNTIL " + (skeleton-read "Condition: ") > \n + > _ \n + "END-PERFORM" > \n) + +(defun cobol-when-with-also (prompt num-also) + "Create a WHEN clause skeleton with provided PROMPT and NUM-ALSO ALSOs." + `(,prompt "WHEN " str + ,@(let ((clauses nil)) + (dotimes (_ num-also) + (push `(" ALSO " (skeleton-read ,prompt)) clauses)) + clauses) + > \n > _ \n)) + +(defvar cobol--num-conds) + +(cobol--def-skeleton "evaluate" + "Insert an EVALUATE - END-EVALUATE block." + "Variable/TRUE: " + ;; This is set like so because cobol--num-conds is incremented even when no str is supplied. + '(setf cobol--num-conds -1) + > "EVALUATE " str ("Variable/TRUE: " + '(setf cobol--num-conds (1+ cobol--num-conds)) + " ALSO " str) + > \n + (cobol-when-with-also "Value/Condition: " cobol--num-conds) + "END-EVALUATE") + +(cobol--def-skeleton "program" + "Insert an empty PROGRAM." + "Program name: " + > "IDENTIFICATION DIVISION." > \n + "PROGRAM-ID. " str "." > \n + > \n + "DATA DIVISION." > \n + "WORKING-STORAGE SECTION." > \n + > _ \n + "PROCEDURE DIVISION." > \n + > \n + "END PROGRAM " str "." > \n) + +(cobol--def-skeleton "function" + "Insert an empty FUNCTION." + "Function name: " + > "IDENTIFICATION DIVISION." > \n + "FUNCTION-ID. " str "." > \n + > \n + "DATA DIVISION." > \n + "LOCAL-STORAGE SECTION." > \n + > \n + "LINKAGE SECTION." > \n + > _ \n + "PROCEDURE DIVISION RETURNING ." > \n + > \n + "END FUNCTION " str "." > \n) + +(cobol--def-skeleton "method" + "Insert an empty METHOD." + "Method name: " + > "IDENTIFICATION DIVISION." > \n + "METHOD-ID. " str "." > \n + > \n + "DATA DIVISION." > \n + "LOCAL-STORAGE SECTION." > \n + > _ \n + "PROCEDURE DIVISION." > \n + > \n + "END METHOD " str "." > \n) + +(cobol--def-skeleton "class" + "Insert an empty CLASS." + "Class name: " + > "IDENTIFICATION DIVISION." > \n + "CLASS-ID. " str "." > \n + > _ \n + "FACTORY." > \n + "END FACTORY." > \n + > \n + "OBJECT." > \n + "END OBJECT." > \n + "END CLASS " str "." > \n) + +(cobol--def-skeleton "interface" + "Insert an empty INTERFACE." + "Interface name: " + > "IDENTIFICATION DIVISION." > \n + "INTERFACE-ID. " str "." > \n + > _ \n + "FACTORY." > \n + "END FACTORY." > \n + > \n + "OBJECT." > \n + "END OBJECT." > \n + "END INTERFACE " str "." > \n) + +;;; Code formatting + +(defconst cobol-formats + '(upper-case lower-case capitalised-all capitalised-verbs) + "The different formats supported when formatting COBOL code.") + +(defcustom cobol-format-style 'upper-case + "The type of formatting used when formatting COBOL code." + :type (cobol--radio-of-list cobol-formats) + :safe (cobol--val-in-list-p cobol-formats)) + +(defun cobol-format-word (word) + "Return WORD formatted according to `cobol-format-style'." + (cond + ((eql cobol-format-style 'upper-case) + (upcase word)) + ((eql cobol-format-style 'lower-case) + (downcase word)) + ((eql cobol-format-style 'capitalised-all) + (capitalize word)) + ((eql cobol-format-style 'capitalised-verbs) + (if (memq word cobol-verbs) + (capitalize word) + (downcase word))))) + +(defun cobol-format-region (beg end) + "Format all COBOL words between BEG and END according to +`cobol-format-style'." + (interactive "*r") + (cobol-format beg end)) + +(defun cobol-format-buffer () + "Format all COBOL words in the current buffer according to +`cobol-format-style'." + (interactive "*") + (cobol-format (point-min) (point-max))) + +(defun cobol-format (beg end) + "Format COBOL code between BEG and END according to `cobol-format-style'." + (defconst words-to-format + (append cobol-directives cobol-verbs cobol-keywords cobol-intrinsics + cobol-symbolic-literals)) + + (save-excursion + (dolist (word words-to-format) + (let ((ref-point (point-min))) + (goto-char beg) + (while (search-forward-regexp (concat "\\<" word "\\>") end t) + (when (not (let ((state (parse-partial-sexp ref-point (point)))) + (or (nth 3 state) (nth 4 state)))) + (replace-match (cobol-format-word word) t))))))) + +;;; Fixed-form formatting + +(defun cobol-insert-in-sequence-area (beg end text) + "Insert, in the lines between BEG and END, TEXT in the sequence area." + (interactive "*r\nsText: ") + (when (> (length text) 6) + (error "%s is longer than six characters" text)) + (save-excursion + ;; Find rectangle to insert text in. + (let (top-left bottom-right) + ;; Get top left corner of rectangle. + (goto-char beg) + (beginning-of-line) + (when (< (point) beg) + (forward-line 1)) + (setf top-left (point)) + ;; Get bottom right corner of rectangle. + (while (and (<= (+ (point) 6) end) (not (eobp))) + (forward-line 1)) + (forward-line -1) + (setf bottom-right (+ (point) 6)) + (string-rectangle top-left bottom-right (format "%-6s" text))))) + +;;; Indentation +;; Derived (a long time ago) from the wonderful Emacs Mode Tutorial at +;; . + +(defun cobol--code-start () + "Return the first column code can go in." + (if (eq cobol-source-format 'free) + 0 + 7)) + +;;; Misc +(defvar cobol-tab-width 4 "Width of a tab for `cobol-mode'.") + +(cl-defun cobol--indent (indent &optional (times 1)) + "Increment INDENT." + (+ indent (* times cobol-tab-width))) + +(defun cobol--current-indentation () + "Return the indentation of the current line or -1 if the line is within the +sequence area." + (if (< (- (line-end-position) (line-beginning-position)) (cobol--code-start)) + -1 + (save-excursion + (goto-char (+ (line-beginning-position) (cobol--code-start))) + (let ((code-start-position (point))) + (skip-syntax-forward " " (line-end-position)) + (backward-prefix-chars) + (- (point) code-start-position))))) + +(defun cobol--indent-current () + "Return the current indent level indented once." + (cobol--indent (cobol--current-indentation))) + +(defun cobol--search-back (fn) + "Go back a line at a time, calling FN each time. +If the car of the return value is non-nil, return the cdr." + (save-excursion + (cl-do ((ret nil (funcall fn))) + ((car ret) (cdr ret)) + (forward-line -1)))) + +(cl-defun cobol--search-back-for-indent (str &key with-whitespace) + "Return the indent of the previous line starting with the regexp STR (optionally +after whitespace if WITH-WHITESPACE). If that cannot be found, return 0." + (let ((line-re (concat (when with-whitespace cobol--optional-whitespace-re) + str))) + (cobol--search-back + #'(lambda () (cond ((bobp) + (cons t 0)) + ((looking-at line-re) + (cons t (cobol--current-indentation)))))))) + +(defun cobol--indent-of-last-div () + "Return the indent of the last division." + (cobol--search-back-for-indent cobol--division-re)) + +(defun cobol--indent-of-last-div-or-section () + "Return the indent of the preceding division or section." + (cobol--search-back-for-indent "\\w+\\s-+\\(DIVISION\\|SECTION\\)\\." :with-whitespace t)) + +(defun cobol--indent-of-end-marker-match (group) + "Return the indent of the start of GROUP." + (if (memq (upcase group) cobol--non-id-groups) + (cobol--search-back-for-indent + (concat group ".") :with-whitespace t) + (cobol--search-back-for-indent + (cobol--create-id-re group)))) + +(defun cobol--match-with-leading-whitespace (re str) + "Match regexp RE (with optional leading whitespace) against STR." + (string-match (concat cobol--optional-leading-whitespace-line-re re) + str)) + +(defun cobol--match-line-with-leading-whitespace (re) + "Match regexp RE (with optional leading whitespace) against the current line." + (cobol--match-with-leading-whitespace re (thing-at-point 'line))) + +(defun cobol--get-level-number (declaration) + "Return the level-number of DECLARATION. +If the declaration does not have a level number, return zero." + (string-match cobol--generic-declaration-re declaration) + (string-to-number (match-string 1 declaration))) + +(defun cobol--indent-of-group-item (wanted-level-num) + "Return the indentation of the last item with WANTED-LEVEL-NUM or indented +from the last item of lower level." + (cobol--search-back + #'(lambda () + (cond ((looking-at cobol--generic-declaration-re) + (let ((level-num (cobol--get-level-number (thing-at-point 'line)))) + (cond ((eq level-num wanted-level-num) + (cons t (cobol--current-indentation))) + ((< level-num wanted-level-num) + (cons t (cobol--indent-current)))))) + ((bobp) + (cons t 0)))))) + +(defun cobol--indent-of-declaration (decl) + "Return the indentation of the declaration DECL." + (let ((level-num (cobol--get-level-number decl))) + (if (or (>= 1 level-num) (eq 77 level-num) (eq 66 level-num)) + ;; If elementary item or FD/SD/RD. + (cobol--search-back-for-indent cobol--division-re) + ;; Find indent of item with same level or add-indent to previous item of + ;; lower level. (This means 88 levels will always be indented to the + ;; previous item.) + (cobol--indent-of-group-item level-num)))) + +(defun cobol--indent-from-previous () + "Return what the indent of the current line should be based on previous +lines." + (cobol--search-back + #'(lambda () + (cond ((looking-at cobol--env-or-data-div-sections-re) + (cons t (cobol--current-indentation))) + ((or (looking-at cobol--containing-statement-or-phrase-re) + (looking-at cobol--procedure-re) + (looking-at cobol--procedure-division-re)) + (cons t (cobol--indent-current))) + ((or (looking-at cobol--verb-re) + (looking-at cobol--scope-terminator-re) + (looking-at cobol--type-end-marker-re) + (looking-at cobol--function-end-marker-re) + (looking-at cobol--division-re) + (looking-at cobol--generic-declaration-re)) + (cons t (cobol--current-indentation))) + ((bobp) + (cons t 0)))))) + +(defun cobol--phrase-with-not (phrase) + "Return regexp matching line with optional NOT and PHRASE." + (cobol--with-opt-whitespace-line "\\(NOT\\s-+\\)?" phrase)) + +(defun cobol--at-phrase (phrase) + "Return regexp matching PHRASE with optional AT and NOT." + (cobol--phrase-with-not (concat "\\(AT\\s-+\\)?" phrase))) + +(defun cobol--on-phrase (phrase) + "Return regexp matching PHRASE with optional ON and NOT." + (cobol--phrase-with-not (concat "\\(ON\\s-+\\)?" phrase))) + +(defun cobol--statements-with-phrase (str) + "Return a list of statements taking the phrase STR." + (cond ((string-match (cobol--with-opt-whitespace-line "WHEN") + str) + '("EVALUATE" "SEARCH")) + ((string-match (cobol--at-phrase "END-OF-PAGE") str) + '("WRITE")) + ((string-match (cobol--at-phrase "END") str) + ;; An AT END clause is added to OPEN in the XML TR. + '("OPEN" "READ" "RETURN" "SEARCH")) + ((string-match (cobol--on-phrase "OVERFLOW") str) + '("CALL" "STRING" "UNSTRING")) + ((string-match (cobol--on-phrase "EXCEPTION") str) + '("ACCEPT" "CALL" "DISPLAY")) + ((string-match (cobol--on-phrase "ESCAPE") str) + '("ACCEPT")) ; MF/ACUCOBOL extension + ((string-match (cobol--on-phrase "SIZE\\s-+ERROR") str) + '("ADD" "COMPUTE" "DIVIDE" "MULTIPLY" "SUBTRACT")) + ((string-match (cobol--phrase-with-not "INVALID\\s-+KEY") str) + '("DELETE" "READ" "REWRITE" "START")) + (t + (error "Invalid phrase")))) + +(defun cobol--scope-terminator-statement (scope-terminator) + "Return the statement contained in SCOPE-TERMINATOR." + (cobol--match-with-leading-whitespace "END-\\(\\w+\\)" scope-terminator) + (match-string 1 scope-terminator)) + +(defun cobol--first-word (str) + "Return the first word in STR." + (cobol--match-with-leading-whitespace "\\(\\w+\\)" str) + (match-string 1 str)) + +(defun cobol--go-to-open-statement (statements) + "Go to the last open (unterminated) statement in STATEMENTS." + (let* ((statements-re (regexp-opt statements t)) + (valid-statement-re (cobol--with-opt-whitespace-line statements-re)) + (valid-scope-terminator-re cobol--scope-terminator-re) + found) + (while (not found) + (forward-line -1) + (cond ((looking-at valid-statement-re) + ;; Check the scope-terminator is not on the same line. + (let ((scope-terminator + (concat "END-" (cobol--first-word (thing-at-point 'line))))) + (unless (string-match scope-terminator (thing-at-point 'line)) + (setf found t)))) + + ;; Skip past terminated statements + ((looking-at valid-scope-terminator-re) + (let ((terminated-statement + (cobol--scope-terminator-statement (thing-at-point 'line)))) + (cobol--go-to-open-statement (list terminated-statement)))) + + ;; If no statement is found, stop at beginning of buffer. + ((bobp) + (setf found t)))))) + +(defun cobol--indent-of-open-statement (statements) + "Return the indent of the last open statement in STATEMENTS." + (save-excursion + (cobol--go-to-open-statement statements) + (cobol--current-indentation))) + +(defun cobol--indent-of-containing-statement-or-phrase (str) + "Return the indentation of containing statement/phrase in STR." + (let ((phrase (upcase (cobol--first-word str)))) + (cond ((or (string-equal phrase "IF") + (string-equal phrase "EVALUATE") + (string-equal phrase "PERFORM")) + (cobol--indent-from-previous)) + + ((string-equal phrase "ELSE") + (cobol--indent-of-open-statement '("IF"))) + + (t + (cobol--indent (cobol--indent-of-open-statement + (cobol--statements-with-phrase str))))))) + +(defun cobol--get-current-division () + "Return the division containing point as a symbol." + (cobol--search-back + #'(lambda () + (cond ((looking-at cobol--division-re) + (string-match cobol--division-re (thing-at-point 'line)) + (let ((division (downcase (match-string 1 (thing-at-point 'line))))) + (cons t (intern division)))) + + ((or (looking-at cobol--end-marker-re) + (bobp)) + (cons t 'identification)))))) + +(defun cobol--no-instances-of-after-in-division (instance-re after-re division) + "Actual implementation of `cobol--no-instances-of'." + (and (eq division (cobol--get-current-division)) + (cobol--search-back + #'(lambda () + (cond ((looking-at after-re) + (cons t t)) + ((or (looking-at instance-re) + (bobp)) + (cons t nil))))))) + +(defmacro cobol--no-instances-of (re after re2 in division) + "Return non-nil if there are no instances of things matched by RE +between point and the previous instance of RE2. +Return nil if point is not in DIVISION or if nothing is found. +Arguments must be in the form 'RE after RE2 in DIVISION' where +`after' and `in' stand for themselves." + (cl-assert (and (eq after 'after) + (eq in 'in)) + nil + "Clauses should be in the form 're AFTER re-2 IN division'.") + `(cobol--no-instances-of-after-in-division ,re ,re2 ,division)) + +(defun cobol--in-file-control-p () + "Return whether point is in the FILE-CONTROL paragraph." + (cobol--no-instances-of cobol--procedure-re + after (cobol--with-opt-whitespace-line "FILE-CONTROL.") + in 'environment)) + +(defun cobol--no-statements-after (re) + "Return whether there are any statements between point and the previous +instance of RE." + (cobol--no-instances-of cobol--verb-re + after re + in 'procedure)) + +(defun cobol--in-proc-div-param-list-p () + "Return whether point is in the procedure division header parameter list." + (cobol--no-statements-after cobol--procedure-division-re)) + +(defun cobol--in-if-eval-when-or-perform-cond-p () + "Return whether point is in the condition of an IF, EVALUATE or WHEN or in +the clauses of a non-procedural PERFORM." + (cobol--no-statements-after (cobol--with-opt-whitespace-line + cobol--phrases-with-double-indent-after))) + +(defun cobol--indent-of-last-statement () + "Return the indent of the last statement." + (cobol--search-back-for-indent cobol--verb-re)) + +(defun cobol--indent-of-clauses () + "Return the indentation for a clause at point." + (let ((current-division (cobol--get-current-division))) + (cond ((eq current-division 'identification) + (cobol--indent-from-previous)) + + ((eq current-division 'environment) + (if (cobol--in-file-control-p) + ;; Indent clauses of SELECT. + (cobol--indent (cobol--indent-of-last-statement)) + (cobol--indent-from-previous))) + + ((eq current-division 'data) + (- cobol-declaration-clause-indent (cobol--code-start))) + + ((eq current-division 'procedure) + (cond ((cobol--in-proc-div-param-list-p) + ;; Indent procedure division parameter list twice. + (cobol--indent (cobol--search-back-for-indent cobol--procedure-division-re) + 2)) + ((cobol--in-if-eval-when-or-perform-cond-p) + ;; Indent after IF/EVALUATE/WHEN/non-procedural PEROFRM twice. + (cobol--indent (cobol--search-back-for-indent + cobol--phrases-with-double-indent-after + :with-whitespace t) + 2)) + ;; Indent once after any other statement. + (t + (cobol--indent (cobol--indent-of-last-statement)))))))) + +(defun cobol--looking-at-comment-line () + "Return whether we are looking at a comment line (using `looking-at')." + (or (looking-at cobol--free-form-comment-line-re) + (when (cobol--fixed-format-p) + (looking-at cobol--fixed-form-comment-re)))) + +(defun cobol--find-indent-of-line () + "Return what the indent of the current line should be." + (save-excursion + (beginning-of-line) + (cond ((looking-at cobol--scope-terminator-re) + (let ((matching-statement + (cobol--scope-terminator-statement (thing-at-point 'line)))) + (cobol--indent-of-open-statement (list matching-statement)))) + + ((looking-at cobol--procedure-re) + (cobol--indent-of-last-div-or-section)) + + ((looking-at cobol--end-marker-re) + (cobol--match-line-with-leading-whitespace + (concat "END" cobol--identifier-re)) + (let ((group (match-string 1 (thing-at-point 'line)))) + (cobol--indent-of-end-marker-match group))) + + ((looking-at cobol--division-re) + (cobol--indent-of-last-div)) + + ((looking-at cobol--generic-declaration-re) + (cobol--indent-of-declaration (thing-at-point 'line))) + + ((looking-at cobol--containing-statement-or-phrase-re) + (cobol--indent-of-containing-statement-or-phrase + (thing-at-point 'line))) + + ((or (cobol--looking-at-comment-line) + (looking-at cobol--verb-re) + (looking-at cobol--blank-line-re)) + (cobol--indent-from-previous)) + + (t + (cobol--indent-of-clauses))))) + +(defun cobol--indent-point-to-col (col) + "Indent point to COL." + ;; FIXME: Use indent-line-to? + (cond ((< (current-column) col) + (indent-to col)) + ((> (current-column) col) + (delete-char (- col (current-column)))))) + +(defun cobol--set-line-indent (indent) + "Set the indent of the current line to INDENT." + (save-excursion + (let ((line-length (- (line-end-position) (line-beginning-position))) + (end-of-indent (+ (cobol--code-start) indent))) + ;; Following lines derived from source of `back-to-indentation'. + (move-to-column (cobol--code-start)) + (if (>= line-length (cobol--code-start) (current-column)) + (progn + (skip-syntax-forward " " (line-end-position)) + (backward-prefix-chars)) + (indent-to (cobol--code-start))) + + (cobol--indent-point-to-col end-of-indent)))) + +(defun cobol--indent-point () + "Indent point to the next multiple of `cobol-tab-width' (relative to the +start of area A, if fixed-format)." + (cobol--indent-point-to-col + (+ (current-column) (- cobol-tab-width + (% (if (cobol--fixed-format-p) + (1+ (current-column)) + (current-column)) + cobol-tab-width))))) + +(defun cobol-indent-line () + "Indent current line as COBOL code." + (interactive "*") + (let ((indent (cobol--find-indent-of-line))) + (if (not (eq indent (cobol--current-indentation))) + (progn + (cobol--set-line-indent indent) + ;; If in leading whitespace/sequence area, move to first char of code. + (when (< (point) (+ (line-beginning-position) (cobol--code-start) indent)) + (skip-syntax-forward " " (line-end-position)) + (backward-prefix-chars))) + ;; Move to first non-whitespace char + (skip-syntax-forward " " (line-end-position)) + (backward-prefix-chars) + ;; SuperBOL/OCamlPro: the following loop was commented to prevent + ;; inserting spaces at point + ;; Indent stuff at point if not the first word. +; (when (< (cobol--current-indentation) (- (current-column) (cobol--code-start))) +; (cobol--indent-point)) + ))) + +(defvar cobol-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap back-to-indentation] #'cobol-back-to-indentation) + ;;(define-key map (kbd "RET") #'newline-and-indent) + map)) + +(easy-menu-define cobol-mode-menu cobol-mode-map "Menu used for `cobol-mode'." + '("COBOL" + ("Insert" :filter cobol-skeleton--menu) + ;; FIXME: This menu should likely grow a few more entries. + )) + +(defvar cobol-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?- "w" st) + (modify-syntax-entry ?_ "w" st) + (modify-syntax-entry ?* ". 1" st) + (modify-syntax-entry ?> "w 2" st) + (modify-syntax-entry ?\\ "." st) + (modify-syntax-entry ?' "\"" st) + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?\n ">" st) + st)) + +(defvar ac-ignore-case) + +;;;###autoload +(define-derived-mode cobol-mode prog-mode "COBOL" + "COBOL mode is a major mode for handling COBOL files." + + (set (make-local-variable 'font-lock-defaults) cobol-font-lock-defaults) + + (when cobol-tab-width + (set (make-local-variable 'tab-width) cobol-tab-width)) + + (set (make-local-variable 'indent-tabs-mode) nil) + + (set (make-local-variable 'comment-start-skip) + "\\(^.\\{6\\}\\*\\|\\*>\\)\\s-* *") + (set (make-local-variable 'comment-start) "*>") + (set (make-local-variable 'comment-end) "") + + (set (make-local-variable 'syntax-propertize-function) + #'cobol--syntax-propertize-function) + + (set (make-local-variable 'column-number-mode) t) + + (set (make-local-variable 'indent-line-function) #'cobol-indent-line) + + ;; Auto complete mode + (set (make-local-variable 'ac-ignore-case) t) + ) + +(provide 'cobol-mode) + +;;; cobol-mode.el ends here diff --git a/import/gnucobol b/import/gnucobol new file mode 160000 index 000000000..c0d64addf --- /dev/null +++ b/import/gnucobol @@ -0,0 +1 @@ +Subproject commit c0d64addfd83baff21f089e0ab7c92609e291442 diff --git a/import/merlin b/import/merlin new file mode 160000 index 000000000..56590ff8e --- /dev/null +++ b/import/merlin @@ -0,0 +1 @@ +Subproject commit 56590ff8e477bbd74fb81c55884009b2f19543b3 diff --git a/opam/cobol_ast.opam b/opam/cobol_ast.opam new file mode 100644 index 000000000..0dcc4abfb --- /dev/null +++ b/opam/cobol_ast.opam @@ -0,0 +1,54 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_ast" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppx_deriving" {>= "5.2.1"} + "cobol_common" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_common.opam b/opam/cobol_common.opam new file mode 100644 index 000000000..a2476e820 --- /dev/null +++ b/opam/cobol_common.opam @@ -0,0 +1,54 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_common" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "pretty" {= version} + "ppx_deriving" {>= "5.2.1"} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_config.opam b/opam/cobol_config.opam new file mode 100644 index 000000000..64bb9980c --- /dev/null +++ b/opam/cobol_config.opam @@ -0,0 +1,56 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_config" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "pretty" {= version} + "ppx_deriving" {>= "5.2.1"} + "menhir" {>= "1.2"} + "cobol_common" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_data.opam b/opam/cobol_data.opam new file mode 100644 index 000000000..cb98e7ab2 --- /dev/null +++ b/opam/cobol_data.opam @@ -0,0 +1,55 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_data" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppx_deriving" {>= "5.2.1"} + "cobol_parser" {= version} + "cobol_ast" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_indent.opam b/opam/cobol_indent.opam new file mode 100644 index 000000000..b8789b7d7 --- /dev/null +++ b/opam/cobol_indent.opam @@ -0,0 +1,55 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_indent" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "fmt" {>= "0.9"} + "cobol_preproc" {= version} + "cobol_common" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_lsp.opam b/opam/cobol_lsp.opam new file mode 100644 index 000000000..56a4a5453 --- /dev/null +++ b/opam/cobol_lsp.opam @@ -0,0 +1,62 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_lsp" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "toml" {>= "7.1.0" & < "8.0.0"} + "pretty" {= version} + "lsp" {>= "1.15" & < "1.16"} + "jsonrpc" {>= "1.15"} + "cobol_typeck" {= version} + "cobol_parser" {= version} + "cobol_indent" {= version} + "cobol_data" {= version} + "cobol_config" {= version} + "cobol_common" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_parser.opam b/opam/cobol_parser.opam new file mode 100644 index 000000000..eef9eca07 --- /dev/null +++ b/opam/cobol_parser.opam @@ -0,0 +1,60 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_parser" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppx_deriving" {>= "5.2.1"} + "menhir" {>= "1.2"} + "ez_file" {>= "0.3"} + "ebcdic_lib" {= version} + "cobol_preproc" {= version} + "cobol_common" {= version} + "cobol_ast" {= version} + "menhir" {= "20220210"} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_preproc.opam b/opam/cobol_preproc.opam new file mode 100644 index 000000000..fad10063b --- /dev/null +++ b/opam/cobol_preproc.opam @@ -0,0 +1,56 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_preproc" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppx_deriving" {>= "5.2.1"} + "menhir" {>= "1.2"} + "cobol_config" {= version} + "cobol_common" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/cobol_typeck.opam b/opam/cobol_typeck.opam new file mode 100644 index 000000000..901670f05 --- /dev/null +++ b/opam/cobol_typeck.opam @@ -0,0 +1,57 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "cobol_typeck" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppx_deriving" {>= "5.2.1"} + "cobol_parser" {= version} + "cobol_data" {= version} + "cobol_common" {= version} + "cobol_ast" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/ebcdic_lib.opam b/opam/ebcdic_lib.opam new file mode 100644 index 000000000..46f66adcb --- /dev/null +++ b/opam/ebcdic_lib.opam @@ -0,0 +1,52 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "ebcdic_lib" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/ppx_cobcflags.opam b/opam/ppx_cobcflags.opam new file mode 100644 index 000000000..b98a8f32e --- /dev/null +++ b/opam/ppx_cobcflags.opam @@ -0,0 +1,53 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "ppx_cobcflags" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ppxlib" {>= "0.15"} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/pretty.opam b/opam/pretty.opam new file mode 100644 index 000000000..50028cafd --- /dev/null +++ b/opam/pretty.opam @@ -0,0 +1,54 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "pretty" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "fmt" {>= "0.9"} + "ez_file" {>= "0.3"} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/superbol-free.opam b/opam/superbol-free.opam new file mode 100644 index 000000000..d4d4ef53e --- /dev/null +++ b/opam/superbol-free.opam @@ -0,0 +1,53 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "superbol-free" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "superbol_free_lib" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/opam/superbol_free_lib.opam b/opam/superbol_free_lib.opam new file mode 100644 index 000000000..1867f9c79 --- /dev/null +++ b/opam/superbol_free_lib.opam @@ -0,0 +1,60 @@ +# This file was generated by `drom` from `drom.toml`. +# Do not modify, or add to the `skip` field of `drom.toml`. +opam-version: "2.0" +name: "superbol_free_lib" +version: "0.1.0" +license: "MIT" +synopsis: "The superbol-vscode-platform project" +description: """\ +This is the description +of the superbol-vscode-platform OCaml project +""" +authors: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +maintainer: [ + "Fabrice Le Fessant " + "Emilien Lemaire " +] +homepage: "https://ocamlpro.github.io/superbol-vscode-platform" +doc: "https://ocamlpro.github.io/superbol-vscode-platform/sphinx" +bug-reports: "https://github.com/ocamlpro/superbol-vscode-platform/issues" +dev-repo: "git+https://github.com/ocamlpro/superbol-vscode-platform.git" +tags: "org:ocamlpro" +build: [ + ["dune" "subst"] {dev} + ["sh" "-c" "./scripts/before.sh build '%{name}%'"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["sh" "-c" "./scripts/after.sh build '%{name}%'"] +] +install: [ + ["sh" "-c" "./scripts/before.sh install '%{name}%'"] +] +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7.0"} + "ez_file" {>= "0.3"} + "ez_cmdliner" {>= "0.3.0" & < "1.0.0"} + "cobol_typeck" {= version} + "cobol_parser" {= version} + "cobol_lsp" {= version} + "cobol_indent" {= version} + "cobol_common" {= version} + "cobol_ast" {= version} + "ppx_inline_test" {with-test} + "ppx_expect" {with-test} + "odoc" {with-doc} + "ocamlformat" {with-test} +] +# Content of `opam-trailer` field: \ No newline at end of file diff --git a/scripts/before-sphinx.sh b/scripts/before-sphinx.sh new file mode 100755 index 000000000..5b2851e13 --- /dev/null +++ b/scripts/before-sphinx.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +./_build/default/src/lsp/superbol-free/main.exe rst > sphinx/commands.rst diff --git a/sphinx/about.rst b/sphinx/about.rst index c46364747..a169add7b 100644 --- a/sphinx/about.rst +++ b/sphinx/about.rst @@ -1,12 +1,14 @@ About ===== -This is the description -of the superbol-vscode-platform OCaml project +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. Authors ------- +* Nicolas Berthier +* David Declerck * Fabrice Le Fessant * Emilien Lemaire diff --git a/sphinx/commands.rst b/sphinx/commands.rst new file mode 100644 index 000000000..f5eba2dc0 --- /dev/null +++ b/sphinx/commands.rst @@ -0,0 +1,204 @@ + +Sub-commands and Arguments +========================== +Common arguments to all sub-commands: + + +* :code:`-q` or :code:`--quiet` Set verbosity level to 0 + +* :code:`-v` or :code:`--verbose` Increase verbosity level + +Overview of sub-commands:: + + indent file + Indentation + + indent range + Indentation range + + lsp + run LSP server + + pp + Preprocess a list of COBOL files, generating a preprocessed file with extension .i for each of them + + texi2rst + build .texi documentation from gnucobol-docs + + +main.exe indent file +~~~~~~~~~~~~~~~~~~~~~~ + +Indentation + + + +**DESCRIPTION** + + + + +**USAGE** +:: + + main.exe indent file FILES [OPTIONS] + +Where options are: + + +* :code:`FILES` Cobol files to indent + +* :code:`-I DIRECTORY` Add DIRECTORY to library search path + +* :code:`--conf CONF_FILE` Set the configuration file to be used + +* :code:`--dialect DIALECT` or :code:`--std DIALECT` Set the dialect to bu used (overriden by `--conf` if used) + +* :code:`--free` Shorthand for `--source-format FREE` + +* :code:`--indent_config FILE` User defined configuration of indentation + +* :code:`--recovery BOOL` Enable/disable parser recovery after syntax errors (default: true) + +* :code:`--silence STRING` Silence specific messages + +* :code:`--source-format SOURCE_FORMAT` Set the format of source code; allowed values are: { FIXED (the default), FREE} +Overrides `format` from configuration file if present. + +* :code:`--strict` Use the strict configuration + + +main.exe indent range +~~~~~~~~~~~~~~~~~~~~~~~ + +Indentation range + + + +**DESCRIPTION** + + + + +**USAGE** +:: + + main.exe indent range FILE RANGE_START RANGE_END [OPTIONS] + +Where options are: + + +* :code:`FILE` file to check the indentation + +* :code:`RANGE_START` start line of range + +* :code:`RANGE_END` end line of range + +* :code:`-I DIRECTORY` Add DIRECTORY to library search path + +* :code:`--conf CONF_FILE` Set the configuration file to be used + +* :code:`--dialect DIALECT` or :code:`--std DIALECT` Set the dialect to bu used (overriden by `--conf` if used) + +* :code:`--free` Shorthand for `--source-format FREE` + +* :code:`--indent_config FILE` User defined offset table file + +* :code:`--recovery BOOL` Enable/disable parser recovery after syntax errors (default: true) + +* :code:`--silence STRING` Silence specific messages + +* :code:`--source-format SOURCE_FORMAT` Set the format of source code; allowed values are: { FIXED (the default), FREE} +Overrides `format` from configuration file if present. + +* :code:`--strict` Use the strict configuration + + +main.exe lsp +~~~~~~~~~~~~~~ + +run LSP server + + + +**DESCRIPTION** + + +Start a COBOL LSP server + +**USAGE** +:: + + main.exe lsp [OPTIONS] + +Where options are: + + + +main.exe pp +~~~~~~~~~~~~~ + +Preprocess a list of COBOL files, generating a preprocessed file with extension .i for each of them + + + +**DESCRIPTION** + + + + +**USAGE** +:: + + main.exe pp FILE [OPTIONS] + +Where options are: + + +* :code:`FILE` Cobol file to preprocess + +* :code:`-I DIRECTORY` Add DIRECTORY to library search path + +* :code:`--cobc` Activate cobc specific features + +* :code:`--conf CONF_FILE` Set the configuration file to be used + +* :code:`--dialect DIALECT` or :code:`--std DIALECT` Set the dialect to bu used (overriden by `--conf` if used) + +* :code:`--free` Shorthand for `--source-format FREE` + +* :code:`--output FILE` or :code:`-o FILE` Output File (use '-' for stdout) + +* :code:`--recovery BOOL` Enable/disable parser recovery after syntax errors (default: true) + +* :code:`--silence STRING` Silence specific messages + +* :code:`--source-format SOURCE_FORMAT` Set the format of source code; allowed values are: { FIXED (the default), FREE} +Overrides `format` from configuration file if present. + +* :code:`--strict` Use the strict configuration + + +main.exe texi2rst +~~~~~~~~~~~~~~~~~~~ + +build .texi documentation from gnucobol-docs + + + +**DESCRIPTION** + + +Build .texi documentation from gnucobol-docs. + +**USAGE** +:: + + main.exe texi2rst FILE [OPTIONS] + +Where options are: + + +* :code:`FILE` .texi file + +* :code:`-o DIR` Target directory for RST generation diff --git a/sphinx/conf.py b/sphinx/conf.py index c4cb173c3..0d6be8589 100644 --- a/sphinx/conf.py +++ b/sphinx/conf.py @@ -1,7 +1,7 @@ #!/usr/bin/env python3 # -*- coding: utf-8 -*- # -# superbol-vscode-platform documentation build configuration file, created by +# superbol documentation build configuration file, created by # sphinx-quickstart. # # This file is execfile()d with the current directory set to its @@ -50,9 +50,9 @@ master_doc = 'index' # General information about the project. -project = 'superbol-vscode-platform' +project = 'superbol' copyright = 'OCamlPro SAS' -author = 'Fabrice Le Fessant ' +author = 'Nicolas Berthier & David Declerck & Fabrice Le Fessant & Emilien Lemaire ' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the @@ -167,7 +167,7 @@ # (source start file, target name, title, # author, documentclass [howto, manual, or own class]). latex_documents = [ - (master_doc, 'superbol-vscode-platform.tex', 'superbol-vscode-platform Documentation', + (master_doc, 'superbol.tex', 'superbol Documentation', 'author', 'manual'), ] @@ -177,7 +177,7 @@ # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). man_pages = [ - (master_doc, 'superbol-vscode-platform', 'superbol-vscode-platform Documentation', + (master_doc, 'superbol', 'superbol Documentation', [author], 1) ] @@ -188,8 +188,8 @@ # (source start file, target name, title, author, # dir menu entry, description, category) texinfo_documents = [ - (master_doc, 'superbol-vscode-platform', 'superbol-vscode-platform Documentation', - author, 'superbol-vscode-platform', 'One line description of project.', + (master_doc, 'superbol', 'superbol Documentation', + author, 'superbol', 'One line description of project.', 'Miscellaneous'), ] diff --git a/sphinx/conf.py.drom-tpl b/sphinx/conf.py.drom-tpl new file mode 100644 index 000000000..0d6be8589 --- /dev/null +++ b/sphinx/conf.py.drom-tpl @@ -0,0 +1,223 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- +# +# superbol documentation build configuration file, created by +# sphinx-quickstart. +# +# This file is execfile()d with the current directory set to its +# containing dir. +# +# Note that not all possible configuration values are present in this +# autogenerated file. +# +# All configuration values have a default; values that are commented out +# serve to show the default. + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +# sys.path.insert(0, os.path.abspath('.')) + +import os +import sys +import datetime +import subprocess +from os import environ +sys.path.insert(0, os.path.abspath('.') + '/_extensions') + +# -- General configuration ------------------------------------------------ + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +#extensions = ['sphinx.ext.extlinks'] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +source_suffix = ['.rst', '.md'] +# source_suffix = '.rst' + +# The master toctree document. +master_doc = 'index' + +# General information about the project. +project = 'superbol' +copyright = 'OCamlPro SAS' +author = 'Nicolas Berthier & David Declerck & Fabrice Le Fessant & Emilien Lemaire ' + +# The version info for the project you're documenting, acts as replacement for +# |version| and |release|, also used in various other places throughout the +# built documents. +# +# The short X.Y version. + +git = subprocess.check_output("git describe --always", shell=True).decode("utf-8") +branch= subprocess.check_output("git rev-parse --abbrev-ref HEAD", shell=True).decode("utf-8") +version = branch + " (" + git + ")" +# version = os.environ.get('CI_COMMIT_REF_NAME', 'v1.0') +# The full version, including alpha/beta/rc tags. +release = version + datetime.datetime.now().strftime(" (%Y/%m/%d %H:%M)") +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = None + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This patterns also effect to html_static_path and html_extra_path +exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store', 'doc_gen'] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'lovelace' + +# Deactivate syntax highlighting +# - http://www.sphinx-doc.org/en/stable/markup/code.html#code-examples +# - http://www.sphinx-doc.org/en/stable/config.html#confval-highlight_language +highlight_language = 'ocaml' +# TODO write a Pygments lexer for Michelson +# cf. http://pygments.org/docs/lexerdevelopment/ and http://pygments.org/docs/lexers/ + + +# If true, `todo` and `todoList` produce output, else they produce nothing. +todo_include_todos = False + + +# -- Options for HTML output ---------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = "sphinx_rtd_theme" + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +html_theme_options = {'logo_only': True} +# html_logo = "logo.svg" +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] + +# Custom sidebar templates, must be a dictionary that maps document names +# to template names. +# +# This is required for the alabaster theme +# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars +# html_sidebars = { +# '**': [ +# 'relations.html', # needs 'show_related': True theme option to display +# 'searchbox.html', +# ] +# } + + +# -- Options for HTMLHelp output ------------------------------------------ + +# Output file base name for HTML help builder. +htmlhelp_basename = 'Liqdoc' + + +# -- Options for LaTeX output --------------------------------------------- + +latex_elements = { + 'inputenc':'', + 'utf8extra': '', + 'preamble': r''' + \usepackage{fontspec} + \IfFontExistsTF{Lato}{\setsansfont{Lato}}{\setsansfont{Arial}} + \IfFontExistsTF{Linux Libertine O}{ + \setromanfont[Scale=1.1]{Linux Libertine O} + }{\setromanfont{Times New Roman}} + \IfFontExistsTF{DejaVu Sans Mono}{ + \setmonofont[Scale=MatchLowercase]{DejaVu Sans Mono} + }{\setmonofont[Scale=MatchLowercase]{Courier}} + ''', + + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'superbol.tex', 'superbol Documentation', + 'author', 'manual'), +] + + +# -- Options for manual page output --------------------------------------- + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'superbol', 'superbol Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'superbol', 'superbol Documentation', + author, 'superbol', 'One line description of project.', + 'Miscellaneous'), +] + +# -- Ignore fragments in linkcheck + +linkcheck_anchors = False + + +# -- Options for Epub output ------------------------------------------------- + +# Bibliographic Dublin Core info. +epub_title = project +epub_author = author +epub_publisher = author +epub_copyright = copyright + +# The unique identifier of the text. This can be a ISBN number +# or the project homepage. +# +# epub_identifier = '' + +# A unique identification for the text. +# +# epub_uid = '' + +# A list of files that should not be packed into the epub file. +epub_exclude_files = ['search.html'] + +# entry point for setup +def setup(app): + app.add_css_file('css/fixes.css') diff --git a/sphinx/debug.rst b/sphinx/debug.rst new file mode 100644 index 000000000..28227acb5 --- /dev/null +++ b/sphinx/debug.rst @@ -0,0 +1,177 @@ +Superbol VSCode Debug +===================== + +This extension is used debug and check coverage of your COBOL code. It must be used with :code:`Superbol VSCode Platform` +to recognize the :code:`COBOL` files. + +Usage +----- + +If you do not already have a configuration, go to the :code:`Run and Debug` pane (:code:`Ctrl + Shift + D`), + +Click on :code:`Show all automatic debug configurations` and select :code:`Add configuration...` +and :code:`COBOL Debugger`. + +This will add the necessary configurations to your :code:`launch.json` file (or create it if needed). + +Once you have your debugging configuration (see :ref:`configuration`), you can launch debugging +by pressing :code:`F5` while being in the COBOL file you wish to debug. + +TODO: screenshots. + +Extension settings +------------------ + +These settings are to be modified by going to :code:`File` > :code:`Preferences` > :code:`Settings` + +Then select the :code:`Extensions` submenu and select :code:`Superbol Debugger`. + +:code:`cobcpath` [1]_ +^^^^^^^^^^^^^^^^^^^^^ + +This is the path to the :code:`cobc` executable, which will be used to build your application. + +Default is :code:`cobc`. + +:code:`gdbpath` +^^^^^^^^^^^^^^^ + +This is the path to the :code:`gdb` executable, which will be used to launch the debugger. + +Default is :code:`gdb`. + +:code:`target` +^^^^^^^^^^^^^^ + +This is the path to your source code, it is relative to the VSCode workspace (or it can +be an absolute path). This will be overriden by the :code:`target` field in the debugging +configurations if specified (cf. next section). + +Default is :code:`${file}`. + +:code:`cwd` +^^^^^^^^^^^ + +This is the root directory of your project. This will be overriden by the :code:`cwd` field in +the debugging configurations if specified (cf. next section). + +Default is :code:`${workspaceRoot}`. + +:code:`display_variable_attributes` +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +Set this to :code:`true` if you want to display data storages and fields attributes (e.g. size of +alphanumerics or digits and scale of numerics). + +Default is :code:`false`. + +.. _configuration: + +Debugging configurations +------------------------ + +These configurations are to be added in your :code:`.vscode/launch.json` file. There are two +types of configurations: :code:`launch` and :code:`attach`. +Attach can be :code:`local` or :code:`remote`. + +.. _launch: + +:code:`launch` Configuration +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This configuration is used to launch the compiled program with the debugger. This configuration +has the following defaults: + +.. code-block:: json + + { + "name": "Superbol debugger", + "type": "gdb", + "request": "launch", + "target": "${file}", + "arguments": null, + "cwd": "${workspaceRoot}", + "gdbpath": "gdb", + "cobcpath": "cobc", + "cobcargs": [ + "-free", + "-x" + ], + "group": [], + "env": null, + "coverage": true, + "verbose": false + } + +The minimal configuration is as follow (all missing elements are either using the extension +settings value if they exists or the default value given just above): + +.. code-block:: json + + { + "name": "Superbol debugger", + "type": "gdb", + "request": "launch", + } + +The items of the configuration have the following effects: + +* :code:`target`: changes the target to be executed with the debugger; +* :code:`arguments`: the arguments that the debugger will pass to the target; +* :code:`cwd`: the path to the project root; +* :code:`gdbpath`: the path to the :code:`gdb` executable; +* :code:`cobcpath`: the path to the :code:`cobc` executable [1]_; +* :code:`cobcargs`: the arguments to pass to :code:`cobc` [1]_; +* :code:`group`: other files in the compilation group (other than :code:`target`) [1]_; +* :code:`env`: an object containing environment variables +* :code:`coverage`: weither to show the coverage of the debugged file; +* :code:`verbose`: show the debugger output in the :code:`Debug Console` view (for debugging only). + +:code:`attach` Configuration +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +The default configuration is as follow: + +.. code-block:: json + + { + "name": "Superbol debugger", + "type": "gdb", + "request": "launch", + "target": "${file}", + "arguments": null, + "cwd": "${workspaceRoot}", + "gdbpath": "gdb", + "cobcpath": "cobc", + "cobcargs": [ + "-free", + "-x" + ], + "group": [], + "env": null, + "coverage": true, + "verbose": false, + "pid": null, + "remoteDebugger": null + } + +However this configuration will not work, as either :code:`pid` or :code:`remoteDebugger` must +have a value. All other values have the same usage as in :ref:`launch`. + +* :code:`pid`: The id of the process to attach to in a local attach configuration; +* :code:`remoteDebugger`: The address of the :code:`gdb` server to attach to, with format :code:`host:port`. + +Coverage +-------- + +If you are running the debugger with a :code:`launch` request and set :code:`coverage` to :code:`true`, +then once the debugger has stopped running, you will see the coverage status of every line in the +:code:`PROCEDURE DIVISION`. + +A red line signifies that the line is never runned. + +A green line signifies that the line is runned. + +---- + +.. [1] These options are to be removed to use the :code:`Superbol VSCode Platform` build tasks. diff --git a/sphinx/emacs.rst b/sphinx/emacs.rst new file mode 100644 index 000000000..e4c52f965 --- /dev/null +++ b/sphinx/emacs.rst @@ -0,0 +1,48 @@ +Emacs modes +=========== + +Standard file :code:`cobol-mode.el` +----------------------------------- + +We provide our own fork of :code:`cobol-mode.el` from ELPA, with a fix +on the indentation function preventing insertion of spaces at point. + +Installation +~~~~~~~~~~~~ + +Copy the file :code:`cobol-mode.el` to your :code:`$HOME/.emacs.d/` +directory, and add the following lines to your :code:`$HOME/.emacs` file:: + + (autoload 'cobol-mode "cobol-mode") + (setq cobol-tab-width 3) + (setq auto-mode-alist + (append + '(("\\.cob\\'" . cobol-mode) + ("\\.cbl\\'" . cobol-mode) + ("\\.cpy\\'" . cobol-mode)) + auto-mode-alist)) + (setq cobol-source-format 'free) + +This configuration will set tabulations to be 3 spaces and free source +format. If you want to change the source format, you will need to +change this option using :code:`M-x customize`, save and then restart emacs. + +Features +~~~~~~~~ + +The :code:`cobol-mode.el` provides a following features: + +* colorization +* indentation +* comments +* rulers +* a COBOL menu with an item "Insert" with a few constructions + +Customization +~~~~~~~~~~~~~ + +* cobol-skeleton-alist (check the `cobol--def-skeleton` function) + +We advise to also use the :code:`auto-complete` mode also. This mode +will propose completions while typing keywords (use TAB or RET to +complete). diff --git a/sphinx/index.rst b/sphinx/index.rst index d9ac5dd76..5e0fd679d 100644 --- a/sphinx/index.rst +++ b/sphinx/index.rst @@ -13,9 +13,6 @@ Welcome to superbol-vscode-platform Home about install - settings - features - tasks API doc license diff --git a/sphinx/install-vscode.rst b/sphinx/install-vscode.rst new file mode 100644 index 000000000..546ab4808 --- /dev/null +++ b/sphinx/install-vscode.rst @@ -0,0 +1,38 @@ +Install VSCode extensions +========================= + +From marketplace +---------------- + +TODO + +From :code:`.vsix` files +------------------------ + +You can build the vsix files from source. For :code:`superbol-vscode-platform`, run the following +commands: + +.. code-block:: shell + + yarn install #if not already done + drom build + make compile + yarn package + +For :code:`superbol-vscode-debug`, run the follwing command: + +.. code-block:: shell + + yarn compile + vsce package + +With those commands you should have respectively :code:`superbol-vscode-platform.vsix` and +:code:`superbol-vscode-debug.vsix` in the project root directory. + +To install them open VSCode and go the the :code:`Extensions` view. + +Click on the :code:`...` at the top right of the left pane and select :code:`Install from VSIX ...`. + +Select the :code:`superbol-vscode-debug.vsix` file first to install it. + +Finally select the :code:`superbol-vscode-platform.vsix` file to install it. diff --git a/sphinx/install.rst b/sphinx/install.rst index 027ceae17..69a8100e1 100644 --- a/sphinx/install.rst +++ b/sphinx/install.rst @@ -1,5 +1,42 @@ How to install ============== -Please check `README.md `_ for -installation guidelines. +Install with :code:`opam` +------------------------- + +If :code:`superbol-vscode-platform` is available in your opam repository, you can just call:: + + opam install superbol-vscode-platform + +Build and install with :code:`dune` +----------------------------------- + +Checkout the sources of :code:`superbol-vscode-platform` in a directory. + +You need a switch with at least version :code:`4.13.0` of OCaml, +you can for example create it with:: + + opam switch create 4.13.0 + +Then, you need to install all the dependencies:: + + opam install --deps-only . + +Finally, you can build the package and install it:: + + eval $(opam env) + dune build + dune install + +Note that a :code:`Makefile` is provided, it contains the following +targets: + +* :code:`build`: build the code +* :code:`install`: install the generated files +* :code:`build-deps`: install opam dependencies +* :code:`sphinx`: build sphinx documentation (from the :code:`sphinx/` directory) +* :code:`dev-deps`: build development dependencies, in particular + :code:`ocamlformat`, :code:`odoc` and :code:`merlin` +* :code:`doc`: build documentation with :code:`odoc` +* :code:`fmt`: format the code using :code:`ocamlformat` +* :code:`test`: run tests diff --git a/sphinx/lsp.rst b/sphinx/lsp.rst new file mode 100644 index 000000000..038aff71f --- /dev/null +++ b/sphinx/lsp.rst @@ -0,0 +1,146 @@ +LSP Server +========== + +*Superbol* provides an LSP server for COBOL. Every dialect supported by superbol is supported by the LSP server. + +The server operates on the notion of *projects*, that bundle COBOL source files within a *root directory*, along with a configuration. + +Project layout +-------------- + +A project layout associates a configuration given in a file named :file:`superbol.toml` that is located at the root of the project, with a set of files that contain COBOL source code. A typical structure for a project may look as follows: + +.. code-block:: text + + project + ├── superbol.toml + ├── src + │ └── prog1.cob + │ └── prog2.cob + │ └── ... + └── COPY + └── copy1.cpy + └── copy2.cpy + └── ... + +When a user opens any file that contains COBOL source code, the LSP server looks for the closest parent directory :file:`dir` that directly contains a configuration file :file:`superbol.toml`, and sets :file:`dir` as the root project directory for that file. If no configuration file is found, the project's root is defined as the directory that directly contains the opened file. + +.. note:: + Note that files from distinct projects may be edited all at once via the same LSP server. + + +Project configuration +--------------------- + +The :file:`superbol.toml` at the root of a project is a `TOML`_ file that defines the following configuration fields for the project: + +* :code:`dialect`: Sets the dialect for your project. Possible values are: + + * :code:`"default"` (default if not provided) + * :code:`"COBOL85"` + * :code:`"GnuCOBOL"` + * :code:`"MicroFocus"` or :code:`"MF"` + * :code:`"ACU"` + * :code:`"GCOS"` + * :code:`"IBM"` + +* :code:`strict`: Whether to use the strict configuration for the dialect (default is :code:`false`) + +* :code:`source-format`: Select a specific COBOL source format. Possible values are: + + * :code:`"Auto"` (default) + * :code:`"Free"` + * :code:`"Fixed"` + * :code:`"Variable"` + * :code:`"XOpen"` + * :code:`"xCard"` + * :code:`"CRT"` + * :code:`"Terminal"` + * :code:`"COBOLX"` + +* :code:`copybook`: This array is to be filled with all the directories where copybooks are located. It only contains the current working directory by default. Each element of the array must have a :code:`dir` field. This field may contain the name of a directory that is either: + 1. relative to the project root; or + 2. relative to the directory that contains the COBOL source file that defines the compilation group (when the associated Boolean field :code:`file-relative` holds). + +Every value given as a string for a configuration field is case insensitive, except when it describes a file or directory name. + + +Example configuration +^^^^^^^^^^^^^^^^^^^^^ + +Consider the following project layout: + +.. code-block:: text + + project + ├── superbol.toml + ├── GLOBAL_COPYBOOKS + │ └── global.cpy + └── src + ├── prog1 + │ ├── LOCAL_COPYBOOKS + │ │ └── local.cpy + │ └── prog1.cob + └── prog2 + ├── LOCAL_COPYBOOKS + │ └── local.cpy + └── prog2.cob + + +Then you can provide the following configuration file: + +.. code-block:: toml + :caption: :file:`superbol.toml` + + dialect = "GCOS" + strict = false + source-format = "COBOLX" + + [[copybook]] + dir = "GLOBAL_COPYBOOKS" + + [[copybook]] + dir = "LOCAL_COPYBOOKS" + file-relative = true + +All COBOL code in this project will be considered in GCOS dialect and written in COBOLX source format. + +In addition, the copybook :file:`global.cpy` can be used by any source file from this project. +Furthermore, a :code:`COPY "local.cpy"` in :file:`prog1.cob` will include the copybook :file:`src/prog1/LOCAL_COPYBOOKS/local.copy` (and respectively for :file:`prog2.cob` and :file:`src/prog2/LOCAL_COPYBOOKS/local.copy`). + +Server capabilities +------------------- + +This is a list of all the capabilities the server has, to see how they are used in VSCode, you +can check the :code:`Superbol` extension documentation `here `_. + +Go to definition +^^^^^^^^^^^^^^^^ + +The server handles the :code:`textDocument/definition` request, and can find definition of any +data item in your code. + +Find references +^^^^^^^^^^^^^^^ + +The server can list all the references to a data item in your code with the :code:`textDocument/references` +request + +Code formatting +^^^^^^^^^^^^^^^ + +The server provides a formatter both for the full file or for a selection range. This formatter handles +the :code:`FIXED` and :code:`FREE` format. + +Hover +^^^^^ + +The server provides a way to peek into copybooks via the :code:`textDocument/hover` request (more +hovering features to come) + +Semantic tokens +^^^^^^^^^^^^^^^ + +The server can provide semantic tokens data via the :code:`textDocument/semanticTokens/full` request. + +.. _TOML: https://toml.io/ diff --git a/sphinx/platform.rst b/sphinx/platform.rst new file mode 100644 index 000000000..61a91de81 --- /dev/null +++ b/sphinx/platform.rst @@ -0,0 +1,107 @@ +Superbol VSCode Platform +======================== + +This VSCode extension is used to interface VSCode with the Superbol LSP Server and provides building +tasks for your COBOL projects. + +The extension can be used as a standalone, but is required for the `Superbol VSCode Extension` to +work. + +Tasks +----- +We provide a task definition to build your COBOL files. +The task is defined as follow: + +.. code-block:: json + + { + "type": "superbol", + "copybooks": [], + "sourceFormat": "", + "dialect": "", + "extensions": [], + "forDebugging": false, + "problemMatcher": [], + "label": "superbol: Build file", + "group": { + "kind": "build", + "isDefault": true + } + } + +You can fill the fields with the following values: + +* :code:`copybooks`: an array of string, each string must point a to a directory with copybooks + inside +* :code:`sourceFormat`: a string for the COBOL source format to be used by the compiler +* :code:`dialect`: the dialect to be used by the compiler +* :code:`extensions`: file extensions to resolve COPY (without the leading :code:`.`) +* :code:`forDebugging`: if true then the compiler is :code:`cobcd`, otherwise :code:`cobc`. + +To trigger the building task just push :code:`Ctrl + Shift + B`. + +Settings +-------- + +The settings for the extension are to be modified by going to :code:`File` > :code:`Preferences` > +:code:`Settings`. + +Then select the :code:`Extension` submenu and select :code:`Superbol COBOL`. + +:code:`Path` +^^^^^^^^^^^^ + +This is the path to the :code:`superbol` executable. + +Superbol extension features +--------------------------- + +Go to definition +^^^^^^^^^^^^^^^^ + +You can navigate to the defintion of any variable in your code. Push :code:`F12` on a variable name to go +to it's defintion. This works on: +* every variable in the :code:`PROCEDURE DIVISION`, +* every variable that is on a :code:`RENAME` clause, +* every variable that is used by a :code:`REDEFINES` clause + +Go to references +^^^^^^^^^^^^^^^^ + +You can have a list of references of every variables in your code. Push :code:`Shift + F12` on a variable +name to find all the places it is referenced. + +Semantic highlight +^^^^^^^^^^^^^^^^^^ + +The extension understands your code on a semantic level, giving you better highlighting to make +reading your code easier and focus on the important information of the source code. + +Peek copy +^^^^^^^^^ + +Place your cursor on :code:`COPY` statement and a pop up with the content of the copied file will +appear, giving you all the information you need to understand the code at a glance. + +Indentation +^^^^^^^^^^^ + +You can indent your code for a better understanding of the control flow at a glance. Simply push +:code:`Ctrl + Shift + I` and all the file is indented. + +You can also just select a part of your code and push the same shortcut just to indent the selection. + +Keyboard shortcuts +^^^^^^^^^^^^^^^^^^ + +========================================= =============================================================================================================== +Shortcut Action +========================================= =============================================================================================================== +:code:`F12` Go to the defintion of the item under cursor +:code:`Shift + F12` | List all references of the item under cursor. + If there is only one other reference then navigate directly to it +:code:`Ctrl + Shift + I` (no selection) Format the whole file +:code:`Ctrl + Shift + I` (with selection) Format the selection +:code:`Mouse hover` If on a :code:`COPY` statement peek the content of the copied file. +========================================= =============================================================================================================== + diff --git a/src/lsp/cobol_ast/README.md b/src/lsp/cobol_ast/README.md new file mode 100644 index 000000000..e1336f717 --- /dev/null +++ b/src/lsp/cobol_ast/README.md @@ -0,0 +1,40 @@ +# Cobol_ast package + +This package contains the abstract versions of the AST, to be specialized in other packages. + +For API documentation, please see [index.mld]. + +## Toplevel module + +* cobol_ast.ml + +## AST Definition + +* ast.ml: includes + + * simple_statements.ml + * branching_statements.ml + * data_descr.ml + * misc_descr.ml + * terms.ml + * numericals.ml + * operands.ml + +* raw.ml : defines divisions over AST + +## Helpers and Visitors + +* traveral.ml +* helpers.ml +* raw_visitor.ml: main visitor entry point + * raw_compilation_group_visitor.ml: visitor on compilation groups + * raw_data_division_visitor.ml + * raw_data_sections_visitor.ml + * raw_misc_sections_visitor.ml + * raw_proc_division_visitor.ml + * raw_statements_visitor.ml +* operands_visitor.ml +* terms_visitor.ml + +* abstract.ml: module types with abstract types +* abstract_visitor.ml: classes of visitors with abstract types diff --git a/src/lsp/cobol_ast/abstract.ml b/src/lsp/cobol_ast/abstract.ml new file mode 100644 index 000000000..bda19ab06 --- /dev/null +++ b/src/lsp/cobol_ast/abstract.ml @@ -0,0 +1,51 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module type MISC_SECTIONS = sig + (* IDENTIFICATION_DIVISION *) + type informational_paragraphs [@@deriving show] + type options_paragraph [@@deriving show] + type environment_division [@@deriving show] +end + +module type PICTURE = sig + type picture [@@deriving show] +end + +module type DATA_SECTIONS = sig + type working_storage_section [@@deriving show] + type linkage_section [@@deriving show] + type file_section [@@deriving show] + type communication_section [@@deriving show] + type local_storage_section [@@deriving show] + type report_section [@@deriving show] + type screen_section [@@deriving show] +end + +module type DATA_DIVISION = sig + (* NOTE: could become PROG_DIVISIONS if relevant *) + type data_division [@@deriving show] +end + +module type STATEMENTS = sig + type statement [@@deriving show] + type statements [@@deriving show] +end + +module type PROC_DIVISION = sig + type procedure_division [@@deriving show] +end + +module type COMPILATION_GROUP = sig + type compilation_group [@@deriving show] +end diff --git a/src/lsp/cobol_ast/abstract_visitor.ml b/src/lsp/cobol_ast/abstract_visitor.ml new file mode 100644 index 000000000..508f113eb --- /dev/null +++ b/src/lsp/cobol_ast/abstract_visitor.ml @@ -0,0 +1,91 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Generic visitors for selected AST abstractions *) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Visitor + +module For_misc_sections (Misc_sections: Abstract.MISC_SECTIONS) = struct + open Misc_sections + class virtual ['a] folder = object + method fold_informational_paragraphs: (informational_paragraphs, 'a) fold = default + method fold_options_paragraph: (options_paragraph, 'a) fold = default + method fold_environment_division: (environment_division, 'a) fold = default + method virtual continue_with_informational_paragraphs: informational_paragraphs -> 'a -> 'a + method virtual continue_with_options_paragraph: options_paragraph -> 'a -> 'a + method virtual continue_with_environment_division: environment_division -> 'a -> 'a + end +end + +module For_picture (Picture: Abstract.PICTURE) = struct + open Picture + class virtual ['a] folder = object + method fold_picture: (picture, 'a) fold = default + method virtual continue_with_picture: picture -> 'a -> 'a + end +end + +module For_data_sections (Data_sections: Abstract.DATA_SECTIONS) = struct + open Data_sections + class virtual ['a] folder = object + method fold_working_storage_section: (working_storage_section, 'a) fold = default + method fold_linkage_section : (linkage_section , 'a) fold = default + method fold_file_section : (file_section , 'a) fold = default + method fold_communication_section : (communication_section , 'a) fold = default + method fold_local_storage_section : (local_storage_section , 'a) fold = default + method fold_report_section : (report_section , 'a) fold = default + method fold_screen_section : (screen_section , 'a) fold = default + method virtual continue_with_working_storage_section: working_storage_section -> 'a -> 'a + method virtual continue_with_linkage_section : linkage_section -> 'a -> 'a + method virtual continue_with_file_section : file_section -> 'a -> 'a + method virtual continue_with_communication_section : communication_section -> 'a -> 'a + method virtual continue_with_local_storage_section : local_storage_section -> 'a -> 'a + method virtual continue_with_report_section : report_section -> 'a -> 'a + method virtual continue_with_screen_section : screen_section -> 'a -> 'a + end +end + +module For_data_division (Data_division: Abstract.DATA_DIVISION) = struct + open Data_division + class virtual ['a] folder = object + method fold_data_division: (data_division, 'a) fold = default + method virtual continue_with_data_division: data_division -> 'a -> 'a + end +end + +module For_statements (Statements: Abstract.STATEMENTS) = struct + open Statements + class virtual ['a] folder = object + method fold_statement': (statement with_loc, 'a) fold = default + method fold_statements': (statements with_loc, 'a) fold = default + method virtual continue_with_statement': statement with_loc -> 'a -> 'a + method virtual continue_with_statements': statements with_loc -> 'a -> 'a + end +end + +module For_proc_division (Proc_division: Abstract.PROC_DIVISION) = struct + open Proc_division + class virtual ['a] folder = object + method fold_procedure_division: (procedure_division, 'a) fold = default + method virtual continue_with_procedure_division: procedure_division -> 'a -> 'a + end +end + +module For_compilation_group (Compilation_group: Abstract.COMPILATION_GROUP) = struct + open Compilation_group + class virtual ['a] folder = object + method fold_compilation_group: (compilation_group, 'a) fold = default + (* method virtual continue_with_compilation_group : compilation_group -> 'a -> 'a *) + end +end diff --git a/src/lsp/cobol_ast/ast.ml b/src/lsp/cobol_ast/ast.ml new file mode 100644 index 000000000..684009dff --- /dev/null +++ b/src/lsp/cobol_ast/ast.ml @@ -0,0 +1,19 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +include Terms +include Operands +include Simple_statements +include Branching_statements +include Data_descr +include Misc_descr diff --git a/src/lsp/cobol_ast/branching_statements.ml b/src/lsp/cobol_ast/branching_statements.ml new file mode 100644 index 000000000..5a635cfc9 --- /dev/null +++ b/src/lsp/cobol_ast/branching_statements.ml @@ -0,0 +1,458 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Potentially branching statements *) + +open Terms +open Operands +open Simple_statements + + +(* GOTO DEPENDING *) +type goto_depending_stmt = + { + goto_depending_targets: qualname list; (* procedures *) + goto_depending_on: ident; + } +[@@deriving show, ord] + + +(* Error/exception handlers *) +type handler = + statements +[@@deriving show, ord] + +and dual_handler = + { + dual_handler_pos: handler; (** positive case *) + dual_handler_neg: handler; (** negative case *) + } +[@@deriving show, ord] + + +(* EVAL *) +and evaluate_stmt = + { + eval_subjects: selection_subject list; + eval_branches: evaluate_branch list; + eval_otherwise: statements; + } +[@@deriving show, ord] + +and evaluate_branch = + { + eval_selection: selection_object list list; + eval_actions: statements; + } +[@@deriving show, ord] + + +(* PERFORM *) +and perform_stmt = + { + perform_target: perform_target; + perform_mode: perform_mode option; + } +[@@deriving show, ord] + +and perform_target = + | PerformOutOfLine of qualname procedure_range + | PerformInline of statements +[@@deriving show, ord] + +and perform_mode = + | PerformNTimes of ident_or_intlit + | PerformUntil of + { + with_test: stage option; + until: condition; + } + | PerformVarying of + { + with_test: stage option; + varying: varying_phrase with_loc; + after: varying_phrase with_loc list; + } +[@@deriving show, ord] + +and varying_phrase = + { + varying_ident: ident; + varying_from: ident_or_numlit; + varying_by: ident_or_numlit option; + varying_until: condition; + } +[@@deriving show, ord] + + +(* SEARCH *) +and search_stmt = + { + search_item: qualname; + search_at_end: handler; + search_spec: search_spec; + } +[@@deriving show, ord] + +and search_spec = + | SearchSerial of + { + varying: ident option; + when_clauses: search_when_clause with_loc list; + } + | SearchAll of + { + conditions: search_condition list; + action: branch; + } +[@@deriving show, ord] + +and search_when_clause = + { + search_when_cond: condition; + search_when_stmts: branch; + } +[@@deriving show, ord] + + +(* IF *) +and if_stmt = + { + condition: condition; + then_branch: branch; + else_branch: branch option; + } +[@@deriving show, ord] + + +(* ACCEPT *) +and accept_stmt = + | AcceptGeneric of ident with_loc + | AcceptFromDevice of + { + item: ident with_loc; + device_item: name with_loc; + } + | AcceptTemporal of + { + item: ident with_loc; + date_time: date_time; + } + | AcceptMsgCount of name with_loc + | AcceptAtScreen of + { + item: name with_loc; + position: position option; + on_exception: dual_handler; + } + | AcceptFromEnv of (* MF *) + { + item: ident with_loc; + env_item: ident_or_nonnum with_loc; + on_exception: dual_handler; + } +[@@deriving show, ord] + + +(* +DISPLAY id/lit+ UPON...? WITH...? END_DISP +DISPLAY id AT...? ON EXCEPT? +*) + +and display_stmt = + | DisplayDefault of ident_or_literal + | DisplayDevice of + { + displayed_items: ident_or_literal list; (* non-empty *) + upon: display_target with_loc option; + advancing: bool; + } + | DisplayScreen of + { + screen_item: name with_loc; + position: position option; + on_exception: dual_handler; + } +[@@deriving show, ord] + + +and display_target = + | DisplayUponName of name with_loc + | DisplayUponDeviceViaMnemonic of display_device_mnemonic with_loc + +and display_device_mnemonic = + | DisplayDeviceEnvName + | DisplayDeviceEnvValue + | DisplayDeviceArgNumber + | DisplayDeviceCommandLine + + +(* ADD & SUBTRACT *) +and basic_arithmetic_stmt = + { + basic_arith_operands: basic_arithmetic_operands; + basic_arith_on_size_error: dual_handler; + } +[@@deriving show, ord] + + +(* COMPUTE *) +and compute_stmt = + { + compute_targets: rounded_idents; + compute_expr: expression; + compute_on_size_error: dual_handler; + } +[@@deriving show, ord] + + +(* DELETE *) +and delete_stmt = + { + delete_targets: name with_loc; + delete_retry: retry_clause option; + delete_on_invalid_key: dual_handler; + } +[@@deriving show, ord] + + +(* DIVIDE *) +and divide_stmt = + { + divide_operands: divide_operands; + divide_on_size_error: dual_handler; + } +[@@deriving show, ord] + + +(* MULTIPLY *) +and multiply_stmt = + { + multiply_operands: multiply_operands; + multiply_on_size_error: dual_handler; + } +[@@deriving show, ord] + + +(* RECEIVE *) +and receive_stmt = + { + receive_name: name with_loc; (* CD *) + receive_kind: mcs_awaiting_item; + receive_into: ident; + receive_on_no_data: dual_handler; + } +[@@deriving show, ord] + + +(* RETURN *) +and return_stmt = + { + return_file: name with_loc; + return_into: ident with_loc option; + return_at_end: dual_handler; + } +[@@deriving show, ord] + + +(* REWRITE *) +and rewrite_stmt = + { + rewrite_to: write_target; + rewrite_from: ident_or_literal option; + rewrite_retry: retry_clause option; + rewrite_lock: bool option; + rewrite_invalid_key_handler: dual_handler; + } +[@@deriving show, ord] + + +(* START *) +and start_stmt = + { + start_file: name with_loc; + start_position: start_position option; + start_on_invalid_key: dual_handler; + } +[@@deriving show, ord] + + +(* STRING *) +and string_stmt = + { + string_sources: string_source list; + string_target: ident; + string_pointer: ident option; + string_on_overflow: dual_handler; + } +[@@deriving show, ord] + + +(* UNSTRING *) +and unstring_stmt = + { + unstring_source: ident; + unstring_delimiters: unstring_delimiter list; + unstring_targets: unstring_target list; + unstring_pointer: ident option; + unstring_tallying: ident option; + unstring_on_overflow: dual_handler; + } +[@@deriving show, ord] + + +(* WRITE *) +and write_stmt = + { + write_to: write_target; + write_from: ident_or_literal option; + write_advancing: advancing_phrase option; + write_retry: retry_clause option; + write_lock: bool option; + write_error_handler: (write_error * dual_handler) option; + } +[@@deriving show, ord] + +and write_error = + | WriteAtEndOfPage + | WriteInvalidKey +[@@deriving show, ord] + + + +(* +CALL id/lit USING...? RETURNING...? ON OVERFLOW (on-overflow - archaic) +CALL id/lit USING...? RETURNING...? ON EXCEPT (on-exception) + +CALL (id/lit AS)? NESTED/id USING...? RETURNING...? (program-prototype) +*) + +(* CALL *) +and call_stmt = + { + call_prefix: call_prefix; + call_using: call_using_clause with_loc list; + call_returning: ident with_loc option; + call_error_handler: call_error_handler option; + } +[@@deriving show, ord] + +and call_prefix = + | CallGeneral of ident_or_strlit + | CallProto of + { + called: ident_or_strlit option; + prototype: call_proto; + } +[@@deriving show, ord] + +and call_proto = + | CallProtoIdent of ident + | CallProtoNested +[@@deriving show, ord] + +and call_error_handler = + | CallOnOverflow of handler + | CallOnException of dual_handler +[@@deriving show, ord] + + +(* READ *) +and read_stmt = + { + read_file: name with_loc; + read_direction: read_direction option; + read_into: ident option; + read_lock_behavior: read_lock_behavior option; + read_lock: bool option; + read_key: qualname option; + read_error_handler: (read_error * dual_handler) option; + } +[@@deriving show, ord] + +and read_error = + | ReadAtEnd + | ReadInvalidKey +[@@deriving show, ord] + + + +and statement = + (* TODO: split composed high-level (that depend on statement), and basic + statements *) + (* TODO: term-like unification (long-term) *) + | Accept of accept_stmt + | Add of basic_arithmetic_stmt + | Allocate of allocate_stmt + | Alter of alter_stmt + | Call of call_stmt + | Cancel of ident_or_strlit list (* non-empty *) + | Close of close_stmt + | Compute of compute_stmt + | Continue + | Delete of delete_stmt + | Disable of mcs_command_operands + | Display of display_stmt + | Divide of divide_stmt + | Enable of mcs_command_operands + | Enter of enter_stmt + | Evaluate of evaluate_stmt + | Exit of exit_stmt + | Free of name with_loc list + | Generate of name with_loc + | GoTo of qualname + | GoToDepending of goto_depending_stmt + | GoBack of raising option + | If of if_stmt + | Initialize of initialize_stmt + | Initiate of name with_loc list + | Inspect of inspect_stmt + | Invoke of invoke_stmt + | LoneGoTo (* COB85, obsolete *) + | Merge of merge_stmt + | Move of move_stmt + | Multiply of multiply_stmt + | Open of open_stmt + | Perform of perform_stmt + | Purge of name with_loc + | Raise of raise_operand + | Read of read_stmt + | Receive of receive_stmt + | Release of release_stmt + | Resume of qualname + | ResumeNextStatement + | Return of return_stmt + | Rewrite of rewrite_stmt + | Search of search_stmt + | Send of send_stmt + | Set of set_stmt + | Sort of sort_stmt + | Start of start_stmt + | Stop of stop_stmt + | String of string_stmt + | Subtract of basic_arithmetic_stmt + | Suppress + | Terminate of terminate_stmt + | Transform of transform_stmt + | Unlock of unlock_stmt + | Unstring of unstring_stmt + | Validate of ident list + | Write of write_stmt +[@@deriving show, ord] + +and statements = statement with_loc list [@@deriving show, ord] + +and branch = + | Statements of statements + | NextSentence +[@@deriving show, ord] diff --git a/src/lsp/cobol_ast/cobol_ast.ml b/src/lsp/cobol_ast/cobol_ast.ml new file mode 100644 index 000000000..be858d119 --- /dev/null +++ b/src/lsp/cobol_ast/cobol_ast.ml @@ -0,0 +1,31 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Traversal = Traversal +module Helpers = Helpers + +include Ast + +module Terms_visitor = Terms_visitor +module Operands_visitor = Operands_visitor + +module Abstract = Abstract +module Abstract_visitor = Abstract_visitor + +module Raw = Raw +module Raw_visitor = Raw_visitor +(* module Raw_misc_sections_visitor = Raw_misc_sections_visitor *) +(* module Raw_data_sections_visitor = Raw_data_sections_visitor *) +(* module Raw_data_division_visitor = Raw_data_division_visitor *) +(* module Raw_proc_division_visitor = Raw_proc_division_visitor *) +(* module Raw_compilation_group_visitor = Raw_compilation_group_visitor *) diff --git a/src/lsp/cobol_ast/data_descr.ml b/src/lsp/cobol_ast/data_descr.ml new file mode 100644 index 000000000..a688028e2 --- /dev/null +++ b/src/lsp/cobol_ast/data_descr.ml @@ -0,0 +1,463 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Terms + +(* ----------------------------- DATA DIVISION ----------------------------- *) +type format_clause = + | Bit + | Character + | Numeric +[@@deriving show, ord] + + +type file_block_contents = + | FileBlockContainsCharacters + | FileBlockContainsRecords +[@@deriving show, ord] + + +type record_clause = + | FixedLength of integer + | VariableLength of + { + min_length: integer option; + max_length: integer option; + depending: qualname with_loc option; + } + | FixedOrVariableLength of + { + min_length: integer; + max_length: integer; + } +[@@deriving show, ord] + +type label_clause = + | LabelStandard + | LabelOmitted +[@@deriving show, ord] + +type file_data_clause = + name with_loc list +[@@deriving show, ord] + +type file_linage_clause = (* file descr only *) + { + file_linage_lines: qualname_or_intlit; + file_linage_with_footing_at: qualname_or_intlit option; + file_linage_lines_at_top: qualname_or_intlit option; + file_linage_lines_at_bottom: qualname_or_intlit option; + } +[@@deriving show, ord] + +type data_level = int +[@@deriving show, ord] + +type rename_item = + { + rename_level: data_level with_loc; + rename_to: name with_loc; + rename_renamed: qualname; + rename_through: qualname option; + } +[@@deriving show, ord] + + +type condition_name_item = + { + condition_name_level: data_level with_loc; (* is always 88 *) + condition_name: name with_loc; + condition_name_values: condition_name_value list; + condition_name_alphabet: name with_loc option; + condition_name_when_false: literal option; + } +[@@deriving show, ord] + +and condition_name_value = + { + condition_name_value: literal; + condition_name_through: literal option; + } +[@@deriving show, ord] + + +type data_name = + | DataName of name with_loc + | DataFiller +[@@deriving show, ord] + +(* Format seen on IBM: PICTURE ... SIZE ... LOCALE ... *) +type locale_phrase = + { + locale_name: name with_loc option; + locale_size: integer; + } +[@@deriving show, ord] + +type sign_clause = + { + sign_position: sign_position; + sign_separate_character: bool; + } +[@@deriving show, ord] + +and sign_position = LeadingSign | TrailingSign + +type report_screen_usage_clause = + | Display + | National +[@@deriving show, ord] + +type external_clause = + strlit option +[@@deriving show, ord] + +type group_usage_clause = + | GroupUsageBit + | GroupUsageNational +[@@deriving show, ord] + +type data_occurs_clause = + | OccursFixed of + { + times: integer; + key_is: sort_spec list; + indexed_by: name with_loc list; + } + | OccursDepending of + { + from: integer; + to_: integer; + depending: qualname with_loc; + key_is: sort_spec list; + indexed_by: name with_loc list; + } + | OccursDynamic of + { + capacity_in: name with_loc option; + from: integer option; + to_: integer option; + initialized: bool; + key_is: sort_spec list; + indexed_by: name with_loc list; + } +[@@deriving show, ord] + +and sort_spec = + { + sort_key_direction: sort_direction; + sort_key_names: qualname list; + } +[@@deriving show, ord] + +and sort_direction = + | SortAscending + | SortDescending +[@@deriving show, ord] + +type data_varying = + { + data_varying: name with_loc; + data_varying_from: expression option; + data_varying_by: expression option; + } +[@@deriving show, ord] + +type select_when_clause = + | SelectWhen of name with_loc + | SelectWhenOther +[@@deriving show, ord] + +type synchronized_clause = + | SynchronizedLeft + | SynchronizedRight + | SynchronizedDefault +[@@deriving show, ord] + + +type property_clause = + { + property_with_no: property_kind option; + property_is_final: bool; + } +[@@deriving show, ord] + +and property_kind = + | PropertyGet + | PropertySet +[@@deriving show, ord] + + +type usage_clause = + | Binary + | BinaryChar of signedness option (* +COB2002 *) + | BinaryShort of signedness option (* +COB2002 *) + | BinaryLong of signedness option (* +COB2002 *) + | BinaryDouble of signedness option (* +COB2002 *) + | Bit (* +COB2002 *) + | Display + | FloatBinary32 of endianness_mode option (* +COB2002 *) + | FloatBinary64 of endianness_mode option (* +COB2002 *) + | FloatBinary128 of endianness_mode option (* +COB2002 *) + | FloatDecimal16 of encoding_endianness (* +COB2002 *) + | FloatDecimal34 of encoding_endianness (* +COB2002 *) + | FloatExtended (* +COB2002 *) + | FloatLong (* +COB2002 *) + | FloatShort (* +COB2002 *) + | Index + | National (* +COB2002 *) + | ObjectReference of object_reference_kind option (* +COB2002 *) + | PackedDecimal + | Pointer of name with_loc option (* +COB2002 *) + | FunctionPointer of name with_loc (* +COB2002 *) + | ProgramPointer of name with_loc option (* +COB2002 *) + | UsagePending of [`Comp0 | `Comp1 | `Comp5 | `Comp6 | `CompX | + `CompN | `Comp9 | `Comp10 | `Comp15 ] +[@@deriving show, ord] + +and signedness = + | Signed + | Unsigned +[@@deriving show] + +and endianness_mode = + | HighOrderLeft + | HighOrderRight +[@@deriving show] + +and encoding_mode = + | BinaryEncoding + | DecimalEncoding +[@@deriving show] + +and encoding_endianness = + { + encoding_mode: encoding_mode option; + encoding_endianness: endianness_mode option; + } +[@@deriving show] + +and object_reference_kind = + | ActiveClass of + { + factory_of: bool; + } + | Name of + { + class_or_interface_name: name with_loc; + factory_of: bool; + only: bool; + } +[@@deriving show] + +type validation_clause = + | Class of class_clause + | Default of ident_or_literal option + | Destination of ident list (* non-empty *) + | InvalidWhen of condition list (* non-empty *) + | PresentWhen of condition + | Varying of data_varying list + | ValidateStatus of + { + is_: ident_or_literal; + when_: validate_when; + on: validation_stage list; + for_: ident list; (* non-empty *) + } +[@@deriving show, ord] + +and class_clause = + | Alphabetic + | AlphabeticLower + | AlphabeticUpper + | Boolean + | Numeric + | ClassOrAlphabet of name with_loc +[@@deriving show] + +and validate_when = + | ValidateWhenError + | ValidateWhenNoError +[@@deriving show] + +and validation_stage = + | ValidationStageFormat + | ValidationStageContent + | ValidationStageRelation +[@@deriving show] + +type data_value_clause = + | ValueData of literal + | ValueTable of table_data_value list +[@@deriving show] + +and table_data_value = + { + table_data_values: literal list; (* non-empty *) + table_data_from: subscript list; (* non-empty *) + table_data_to: subscript list; + } +[@@deriving show] + +type report_data_name_or_final = + | ReportDataName of qualident + | ReportFinal +[@@deriving show, ord] + +type report_type_clause = + | Detail + | ReportHeading + | ReportFooting + | PageHeading + | PageFooting + | ControlHeading of (report_data_name_or_final * bool) option + | ControlFooting of report_data_name_or_final option +[@@deriving show, ord] + +type next_group_clause = + | ReportNextAbsolute of integer + | ReportNextRelative of integer + | ReportNextNextPage of bool +[@@deriving show, ord] + +type column_position = + | ColumnAbsolute of integer + | ColumnRelative of integer +[@@deriving show, ord] + +type alignment = + | AlignLeft + | AlignRight + | AlignCenter +[@@deriving show, ord] + +type line_position = + | LineAbsolute of integer * bool + | LineRelative of integer + | LineOnNextPage +[@@deriving show, ord] + +type sum_phrase = + { + sum_operands: expression list; (* non-empty *) + sum_upon_items: name with_loc list; + } +[@@deriving show, ord] + +type polarity = + | Plus + | Minus +[@@deriving show, ord] + +type blank_clause = + | Line + | Screen +[@@deriving show, ord] + +type erase_clause = + | EndOfLine + | EndOfScreen +[@@deriving show, ord] + +type screen_attribute_clause = + | Bell + | Blink + | Highlight + | Lowlight + | ReverseVideo + | Underline + | ForegroundColor of ident_or_intlit + | BackgroundColor of ident_or_intlit +[@@deriving show, ord] + +type screen_line_column_clause = + | Absolute of ident_or_intlit + | Relative of polarity * ident_or_intlit +[@@deriving show, ord] + +type source_destination_clause = + | From of ident_or_literal + | To of ident + | Using of ident + | Value of literal +[@@deriving show, ord] + +type value_of_clause = + { + value_of_valued: name with_loc; + value_of_value: qualname_or_literal; + } +[@@deriving show, ord] + +type report_clause = + | Global + | Code of ident + | Control of + { + final: bool; + controls: name with_loc list; + } + | PageLimit of + { + lines: integer option; + columns: integer option; + heading: integer option; + first_detail: integer option; + last_control_heading: integer option; + last_detail: integer option; + footing: integer option; + } +[@@deriving show, ord] + + +type constant_item = + { + constant_level: data_level with_loc; (* is a constant *) (* TODO: check \in {"1", "01"} *) + constant_name: data_name with_loc option; (* ident only (NB:refine the type???) *) + constant_global: bool; + constant_value: constant_value with_loc; + } +[@@deriving show, ord] + +and constant_value = + | ConstExpr of expression (* or plain ident *) + | ConstByteLength of name with_loc + | ConstLength of name with_loc + | ConstFrom of name with_loc (* compilation variable *) +[@@deriving show, ord] + + +(* --- COMMUNICATION SECTION --- *) + +type comm_clause = + | CommSymbolic of comm_channel * name with_loc + | CommDestinationCount of name with_loc (* OUTPUT only *) + | CommDestinationTable of integer * name with_loc list (* OUTPUT only *) + | CommMessageCount of name with_loc (* INPUT [@@deriving show]*) + | CommMessageDate of name with_loc (* INPUT [@@deriving show]type I-O *) + | CommMessageTime of name with_loc (* INPUT type I-O [@@deriving show]*) + | CommTextLength of name with_loc (* INPUT, OUTPUT [@@deriving show]type I-O *) + | CommStatusKey of name with_loc (* INPUT,[@@deriving show] OUTPUT type I-O *) + | CommEndKey of name with_loc (* INPUT type I-O *) + | CommErrorKey of name with_loc (* OUTPUT only *) +[@@deriving show, ord] + +and comm_channel = + | CommQueue (* INPUT only *) + | CommSubQueue1 (* INPUT only *) + | CommSubQueue2 (* INPUT only *) + | CommSubQueue3 (* INPUT only *) + | CommSource (* INPUT only *) + | CommTerminal (* I-O only *) + | CommDestination (* OUTPUT only *) +[@@deriving show, ord] diff --git a/src/lsp/cobol_ast/dune b/src/lsp/cobol_ast/dune new file mode 100644 index 000000000..05db5b229 --- /dev/null +++ b/src/lsp/cobol_ast/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_ast) + (public_name cobol_ast) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ppx_deriving cobol_common ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show ppx_deriving.ord)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_ast)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_ast/helpers.ml b/src/lsp/cobol_ast/helpers.ml new file mode 100644 index 000000000..9f62bd5a9 --- /dev/null +++ b/src/lsp/cobol_ast/helpers.ml @@ -0,0 +1,36 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.INFIX + +module type TAGS = sig + val loc: Terms.srcloc +end + +module Make (Tags: TAGS) = struct + open Terms + + module Term = struct + let name x : qualname = Name (x &@ Tags.loc) + let qualident x : qualident = + { ident_name = name x; ident_subscripts = []; ident_refmod = None } + let ident x : ident_or_literal = QualIdent (qualident x) + let strlit l : ident_or_literal = Alphanum l + end + + module Cond = struct + open Term + let ident x : condition = Expr (Atom (ident x)) + end + +end diff --git a/src/lsp/cobol_ast/index.mld b/src/lsp/cobol_ast/index.mld new file mode 100644 index 000000000..3840058dc --- /dev/null +++ b/src/lsp/cobol_ast/index.mld @@ -0,0 +1,9 @@ +{1 Library cobol_ast} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This library contains the abstract version of the AST, to be specialized in other packages. + +The entry point of this library is the module: {!Cobol_ast}. + diff --git a/src/lsp/cobol_ast/misc_descr.ml b/src/lsp/cobol_ast/misc_descr.ml new file mode 100644 index 000000000..fe96bb00d --- /dev/null +++ b/src/lsp/cobol_ast/misc_descr.ml @@ -0,0 +1,412 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Terms +open Operands + +(* -------------------- IDENTIFICATION DIVISION (EXTRA) -------------------- *) + +type informational_paragraphs = + { + author: string with_loc option; + installation: string with_loc option; + date_written: string with_loc option; + date_compiled: string with_loc option; + security: string with_loc option; + } +[@@deriving show, ord] + +(* ------------------------- ENVIRONMENT DIVISION -------------------------- *) +type environment_division = + { + env_configuration: configuration_section option; + env_input_output: input_output_section option; + } +[@@deriving show, ord] + +(* ------------- ENVIRONMENT DIVISION / CONFIGURATION SECTION -------------- *) +and configuration_section = + { + source_computer_paragraph: source_computer_paragraph option; + object_computer_paragraph: object_computer_paragraph option; + special_names_paragraph: special_names_paragraph option; + repository_paragraph: repository_paragraph option; (* +COB2002 *) + } +[@@deriving show] + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / SOURCE-COMPUTER PARAGRAPH *) +and source_computer_paragraph = + source_computer option +[@@deriving show] + +and source_computer = + { + source_computer_name: name with_loc; + source_computer_with_debugging_mode: bool; + } +[@@deriving show] + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / OBJECT-COMPUTER PARAGRAPH *) +and object_computer_paragraph = + object_computer option +[@@deriving show] + +and object_computer = + { + object_computer_name: name with_loc; + object_computer_clauses: object_computer_clause with_loc list; + } +[@@deriving show] + +and object_computer_clause = + | ComputerMemorySize of (* ~COB85, -COB2002 *) + integer * memory_size_unit + | ComputerCharClassification of (* +COB2002 *) + { + alphanumeric: locale option; (* at least one must be set *) + national: locale option + } + | ComputerProgCollatingSeq of alphabet_specification (* COB85 != COB2002 *) + | ComputerSegmentLimit of integer (* -COB2002 *) +[@@deriving show] + +and memory_size_unit = + | MemoryWords + | MemoryCharacters + | MemoryModules +[@@deriving show] + +and locale = + | CharClassificationName of name with_loc + | CharClassificationLocale + | CharClassificationSystemDefault + | CharClassificationUserDefault +[@@deriving show] + +and alphabet_specification = (* At least one is required *) + { + alphanumeric: name with_loc option; + national: name with_loc option; + } +[@@deriving show] +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / SPECIAL-NAMES PARAGRAPH *) +and special_names_paragraph = + special_names_clause with_loc list +[@@deriving show] + +and special_names_clause = + | AlphabetName of (* Multiple allowed *) + { + alphabet_name: name with_loc; + category: alphanumeric_or_national; + characters: character_set; + } + | ClassName of (* Multiple allowed *) + { + class_name: name with_loc; + category: alphanumeric_or_national; + characters: character_range list; + source_charset: name with_loc option; + } + | CRTStatus of name with_loc (* +COB2002 *) + | CurrencySign of (* Multiple in COB2002 *) + { + sign: strlit; + picture_symbol: strlit option; + } + | Cursor of name with_loc (* +COB2002 *) + | DecimalPointIsComma + | DynLenStruct of (* +COB2002 *) (* Multiple allowed *) + { + name: name with_loc; + kind: dyn_len_struct_kind; + } + | SpecialNameLocale of (* +COB2002 *) (* Multiple allowed *) + { + locale_name: name with_loc; + external_name: name_or_string; + } + | MnemonicName of (* Multiple allowed *) + { + implementor_name: name with_loc; + mnemonic_name: name with_loc option; + status: status_switch option; + } + | SymbolicChars of (* Multiple allowed *) + { + category: alphanumeric_or_national; + characters: (name with_loc list * integer list) list; (* same lengths *) + source_charset: name with_loc option; + } + | OrderTable of (* +COB2002 *) + { + ordering_name: name with_loc; + cultural_ordering: strlit; + } +[@@deriving show] + +and alphanumeric_or_national = + | Alphanumeric + | National +[@@deriving show] + +and character_range = + | SingleCharacter of strlit_or_intlit + | CharacterRange of range_items +[@@deriving show] + +and characters_range = + | CharactersRange of character_range + | CharactersList of strlit_or_intlit list (* non-trivial *) +[@@deriving show] + +and range_items = + { + start_item: strlit_or_intlit; + end_item: strlit_or_intlit; + } +[@@deriving show] + +and character_set = + | CharSetLocale of name with_loc option (* +COB2002 *) + | CharSetNative (* +COB2002 *) + | CharSetStandard_1 (* Alphanum only *) + | CharSetStandard_2 (* Alphanum only *) + | CharSetUCS_4 (* +COB2002 *) (* National only *) + | CharSetUTF_8 (* +COB2002 *) (* National only *) + | CharSetUTF_16 (* +COB2002 *) (* National only *) + | CharSetCharacters of characters_range list (* non-empty *) +[@@deriving show] + +and dyn_len_struct_kind = + | DynLenPrefixed of { signed: bool; short: bool } + | DynLenDelimited + | DynLenPhysical of name with_loc +[@@deriving show] + +and status_switch = + | StatusSwitchOn of name with_loc + | StatusSwitchOff of name with_loc + | StatusSwitch of { on_: name with_loc; off: name with_loc } +[@@deriving show] + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / REPOSITORY PARAGRAPH *) +and repository_paragraph = + specifier list +[@@deriving show] + +and specifier = (* TODO: inline records *) + | ClassSpecifier of + { + name: name with_loc; + external_name: strlit option; + expands: expands option; + } + | InterfaceSpecifier of + { + name: name with_loc; + external_name: strlit option; + expands: expands option; + } + | UserFunctionSpecifier of + { + name: name with_loc; + external_name: strlit option; + } + | IntrinsicFunctionSpecifier of + name with_loc list (* non-empty *) + | IntrinsicFunctionAllSpecifier + | ProgramSpecifier of + { + name: name with_loc; + external_name: strlit option; + } + | PropertySpecifier of + { + name: name with_loc; + external_name: strlit option; + } +[@@deriving show] + +and expands = + { + expands_name: name with_loc; + expands_using: name with_loc list; (* non-empty *) + } +[@@deriving show] + + +(* -------------- ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION -------------- *) +and input_output_section = + { + file_control_paragraph: file_control_paragraph option; (* COB85: mandatory *) + io_control_paragraph: io_control_paragraph option; + } +[@@deriving show] + +(* - ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION / FILE-CONTROL PARAGRAPH -- *) +and file_control_paragraph = + select list +[@@deriving show] + +and select = + { + select_optional: bool; + select_name: name with_loc; + select_clauses: select_clause with_loc list; + } +[@@deriving show] + +and select_clause = + | SelectAssign of + { + to_: name_or_alphanum list; + using: name with_loc option; + } + | SelectAccessMode of access_mode + | SelectAlternateRecordKey of + { + key: qualname; + source: name with_loc list; + with_duplicates: bool; + } + (* | SelectCollatingSequence of collating_sequence_clause *) + | SelectCollatingSequenceOfFile of + alphabet_specification (* +COB2002 *) (* Multiple *) + | SelectCollatingSequenceOfKey of (* +COB2002 *) (* Multiple *) + { + keys: name with_loc list; + alphabet: name with_loc; + } + | SelectStatus of qualname + | SelectLockMode of (* +COB2002 *) + { + mode: lock_mode; + with_lock: with_lock; + } + | SelectOrganization of organization + | SelectPaddingCharacter of qualname_or_alphanum (* -COB2002 *) + | SelectRecordDelimiter of record_delimiter + | SelectRecordKey of + { + key: qualname; + source: name with_loc list; + } + | SelectRelativeKey of name with_loc + | SelectReserve of integer + | SelectSharing of sharing_mode (* +COB2002 *) +[@@deriving show] + +and access_mode = + | AccessModeDynamic + | AccessModeRandom + | AccessModeSequential +[@@deriving show] + +and lock_mode = + | LockManual + | LockAutomatic +[@@deriving show] + +and with_lock = + | WithLockNone + | WithLock of { multiple: bool } +[@@deriving show] + +and organization = + | OrganizationIndexed + | OrganizationRelative + | OrganizationSequential +[@@deriving show] + +and record_delimiter = + | Standard_1 +[@@deriving show] + +(* -- ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION / I-O-CONTROL PARAGRAPH -- *) +and io_control_paragraph = + io_control_entry option +[@@deriving show] + +and io_control_entry = + { + io_control_rerun_clauses: rerun_clause with_loc list; (* -COB2002 *) + io_control_same_area_clauses: same_area_clause with_loc list; + io_control_multiple_file_clauses: multiple_file_clause with_loc list; (* -COB2002 *) + } +[@@deriving show] + +and rerun_clause = + { + rerun_on: name with_loc option; + rerun_every: rerun_frequency; + } +[@@deriving show] + +and rerun_frequency = + | RerunEndOf of name with_loc + | RerunRecords of integer * name with_loc + | RerunClockUnits of integer + | RerunCond of name with_loc +[@@deriving show] + +and same_area_clause = + { + same_area_source: area_source; + same_area_file_name: name with_loc; + same_area_file_names: name with_loc list; (* non-empty *) + } +[@@deriving show] + +and area_source = + | AreaSourceFile + | AreaSourceRecord + | AreaSourceSortMerge +[@@deriving show] + +and multiple_file_clause = + file_portion list +[@@deriving show] + +and file_portion = + { + file_portion_name: name with_loc; + file_portion_position: integer option; + } +[@@deriving show] + +type options_paragraph = + options_clause with_loc list +[@@deriving show, ord] + +and options_clause = + | Arithmetic of arithmetic_mode + | DefaultRoundedMode of rounding_mode + | EntryConvention of entry_convention + | FloatBinaryDefault of Data_descr.endianness_mode + | FloatDecimalDefault of Data_descr.encoding_endianness (* 1+ *) + | IntermediateRounding of rounding_mode (* not all are valid (TODO: + restriction with type param) *) +[@@deriving show] + +and arithmetic_mode = + | Native + | Standard (* ~COB2002 *) + | StandardBinary + | StandardDecimal +[@@deriving show] + +(* Other conventions may be defined by the implementor *) +and entry_convention = + | COBOL +[@@deriving show] diff --git a/src/lsp/cobol_ast/numericals.ml b/src/lsp/cobol_ast/numericals.ml new file mode 100644 index 000000000..819cd03f5 --- /dev/null +++ b/src/lsp/cobol_ast/numericals.ml @@ -0,0 +1,62 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +type integer = string [@@deriving ord] + +type fixed = + { + fixed_integer: string; (** Integer part *) + fixed_fractional: string; (** Fractional part *) + } [@@deriving ord] + +type floating = + { + float_significand: fixed; + float_exponent: string; (* 0 <= . <= 9999 in ISO/IEC 2014 *) + } [@@deriving ord] + +type boolean = + { + bool_base: [`Bool | `Hex]; + bool_value: string; + } [@@deriving ord] + +(* --- *) + +let pp_integer = Pretty.string + +let fixed_of_strings i d = + { + fixed_integer = i; + fixed_fractional = d; + } + +let pp_fixed ppf { fixed_integer; fixed_fractional } = + Pretty.print ppf "%s.%s" fixed_integer fixed_fractional + +let floating_of_strings i d e = + { + float_significand = fixed_of_strings i d; + float_exponent = e; + } + +let pp_floating ppf { float_significand = s; float_exponent = e } = + Pretty.print ppf "%aE%s" pp_fixed s e + +(* --- *) + +let boolean_of_string ?(base: [`Bool | `Hex] = `Bool) s = + { + bool_base = base; + bool_value = s; + } diff --git a/src/lsp/cobol_ast/operands.ml b/src/lsp/cobol_ast/operands.ml new file mode 100644 index 000000000..492182f83 --- /dev/null +++ b/src/lsp/cobol_ast/operands.ml @@ -0,0 +1,395 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Terms + +(* ACCEPT, DISPLAY *) +type position = + | LinePosition of ident_or_intlit + | ColumnPosition of ident_or_intlit + | LineColumnPosition of ident_or_intlit * ident_or_intlit +[@@deriving show, ord] + +(* CALL, INVOKE *) + +type call_using_clause = + { + call_using_by: call_using_by option; + call_using_expr: expression option;(* [@compare + fun a b -> Option.compare compare_expression a b] *) (** OMITTED if [None] *) + } +[@@deriving show, ord] + +and call_using_by = + | CallUsingByReference + | CallUsingByContent + | CallUsingByValue +[@@deriving show, ord] + + +(* DELETE, OPEN, REWRITE, WRITE, READ (through on_lock_or_retry) *) +type retry_clause = + | RetryNTimes of expression (* arith *) + | RetryForNSeconds of expression (* arith *) + | RetryForever +[@@deriving show, ord] + + +(* ENABLE, DISABLE *) +(* MCS: Message Control System *) + +type mcs_command_operands = + { + mcs_command_kind: mcs_kind; + mcs_command_target: name with_loc; + mcs_command_key: ident_or_alphanum option; + } +[@@deriving show, ord] + +and mcs_kind = + | MCSInput + | MCSOutput + | MCSInputOutput +[@@deriving show, ord] + + +(* SEND, WRITE, PERFORM *) +type stage = + | After + | Before +[@@deriving show, ord] + +(* REWRITE, WRITE *) +type write_target = + | WriteTargetName of qualname + | WriteTargetFile of name with_loc +[@@deriving show ,ord] + +(* +ACCEPT id END_ACC (device or screen) +ACCEPT id FROM DATE/DAY... END_ACC (temporal) +ACCEPT id MESSAGE? COUNT END_ACC (message count?) +ACCEPT id AT ... ON EXCEPT ... END_ACC (screen) +*) + +(* ACCEPT *) +type date_time = + | Date of bool + | Day of bool + | DayOfWeek + | Time +[@@deriving show, ord] + + +(* ADD, SUBTRACT *) +type basic_arithmetic_operands = + | ArithSimple of + { + sources: ident_or_numlit list; + targets: rounded_idents; + } + | ArithGiving of + { + sources: ident_or_numlit list; + to_or_from_item: ident_or_numlit; + targets: rounded_idents; + } + | ArithCorresponding of + { + source: qualname; + target: rounded_ident; + } +[@@deriving show, ord] + + + +(* +DIVIDE id/lit INTO id_rounded+ ON_SIZE...? END_DIV + +DIVIDE id/lit INTO id/lit GIVING... ON_SIZE...? END_DIV +DIVIDE id/lit INTO id/lit GIVING... REMAINDER... ON_SIZE...? END_DIV + +DIVIDE id/lit BY id/lit GIVING... ON_SIZE...? END_DIV +DIVIDE id/lit BY id/lit GIVING... REMAINDER... ON_SIZE...? END_DIV +*) + +(* DIVIDE *) +type divide_operands = + | DivideInto of + { + divisor: ident_or_numlit; + dividends: rounded_idents; (* non-empty *) + } + | DivideGiving of + { + divisor: ident_or_numlit; + dividend: ident_or_numlit; + giving: rounded_idents; + into: bool; (* "INTO" if true, "by" otherwise *) + remainder: ident option; + } +[@@deriving show, ord] + + +(* EVALUATE *) +type selection_subject = + | Subject of condition + | SubjectConst of bool +[@@deriving show, ord] + +type selection_object = + | SelCond of condition (* ident / literal / expression *) + | SelRange of + { + negated: bool; + start: expression; + stop: expression; + alphabet: name with_loc option; + } + | SelRelation of + { + relation: relop; + expr: expression; + } + | SelClassCond of + { + negated: bool; + class_specifier: class_; + } + | SelSignCond of + { + negated: bool; + sign_specifier: signz; + } + | SelOmitted of + { + negated: bool; + } + | SelConst of bool + | SelAny +[@@deriving show, ord] + + +(* MULTIPLY *) +type multiply_operands = + | MultiplyBy of + { + multiplier: ident_or_numlit; + multiplicand: rounded_idents; + } + | MultiplyGiving of + { + multiplier: ident_or_numlit; + multiplicand: ident_or_numlit; + targets: rounded_idents; + } +[@@deriving show, ord] + + +(* OPEN *) +type open_mode = + | OpenInput + | OpenOutput + | OpenInputOutput + | OpenExtend +[@@deriving show, ord] + +type sharing_mode = + | SharingAllOther + | SharingNoOther + | SharingReadOnly +[@@deriving show, ord] + +type file_option = + | FileOptReversed + | FileOptWithNoRewind +[@@deriving show, ord] + + +(* RAISE *) +type raise_operand = + | RaiseIdent of ident + | RaiseException of name with_loc +[@@deriving show, ord] + + +(* EXIT & GO BACK *) +type raising = + | RaisingIdent of ident (* CHECKME: Can ident be a subscript?*) + | RaisingException of name with_loc + | RaisingLastException +[@@deriving show, ord] + + +(* READ *) +type read_direction = + | ReadNext + | ReadPrevious +[@@deriving show, ord] + +type read_lock_behavior = + | ReadAdvancingOnLock + | ReadIgnoringLock + | ReadRetry of retry_clause +[@@deriving show, ord] + + +(* RECEIVE *) +type mcs_awaiting_item = + | MCSMessage + | MCSSegment +[@@deriving show, ord] + + +(* SEARCH *) +type search_condition = + | IsEqual of + { + data_item: qualident; + condition: expression; + } + | Cond of qualident +[@@deriving show, ord] + + +(* SEND, WRITE *) +type advancing_phrase = + | AdvancingLines of + { + stage: stage; + lines: ident_or_intlit; + ambiguous: bool; + } + | AdvancingPage of + { + stage: stage; + } +[@@deriving show, ord] + + +(* SET *) +type set_attribute_switch = + { + set_attribute: screen_attribute; + set_attribute_switch_value: on_off; + } +[@@deriving show, ord] + +and screen_attribute = + | ScreenBell + | ScreenBlink + | ScreenHighlight + | ScreenLowlight + | ScreenReverseVideo + | ScreenUnderline +[@@deriving show, ord] + +and set_ambiguous_method = + | SetMethodUp + | SetMethodDown + | SetMethodTo +[@@deriving show, ord] + +and on_off = + | On + | Off +[@@deriving show, ord] + +and locale_category = + | LcAll + | LcCollate + | LcCtype + | LcMessages + | LcMonetary + | LcNumeric + | LcTime +[@@deriving show, ord] + +and set_save_locale = + | SetSaveLocaleLcAll + | SetSaveLocaleUserDefault +[@@deriving show, ord] + +and set_locale_target = + | SetLocaleTarget of locale_category + | SetLocaleTargetUserDefault +[@@deriving show, ord] + +and set_locale_source = + | SetLocaleSource of ident + | SetLocaleSourceUserDefault + | SetLocaleSourceSystemDefault +[@@deriving show, ord] + +and float_content = + | FarthestFromZero of bool + | NearestToZero of bool + | FloatInfinity + | FloatNotANumber + | FloatNotANumberSignaling +[@@deriving show, ord] + + +(* START *) +type start_position = + | StartPositionFirst + | StartPositionLast + | StartPositionKey of + { + operator: relop; + name: qualname; + length: expression option; + } + (* any relop except IS NOT EQUAL TO or IS NOT = *) +[@@deriving show, ord] + + +(* STRING *) +type string_source = + { + string_source: ident_or_nonnum; + string_delimiter: string_delimiter option; + } +[@@deriving show, ord] + +and string_delimiter = + | StringDelimiter of ident_or_nonnum + | StringDelimiterSize +[@@deriving show, ord] + + +(* UNSTRING *) +type unstring_delimiter = + { + unstring_delimiter: ident_or_strlit; + unstring_delimiter_by_all: bool; + } +[@@deriving show, ord] + +type unstring_target = + { + unstring_target: ident; + unstring_target_delimiter: ident option; + unstring_target_count: ident option; + } +[@@deriving show, ord] + + +(* --- generics --- *) + +type 'a procedure_range = + { + procedure_start: 'a; + procedure_end: 'a option; + } +[@@deriving show, ord] diff --git a/src/lsp/cobol_ast/operands_visitor.ml b/src/lsp/cobol_ast/operands_visitor.ml new file mode 100644 index 000000000..02fa4a717 --- /dev/null +++ b/src/lsp/cobol_ast/operands_visitor.ml @@ -0,0 +1,264 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Terms_visitor +open Ast + +let todo x = Cobol_common.Visitor.todo __FILE__ __MODULE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ __MODULE__ x + +(* --- *) + +class ['a] folder = object + inherit ['a] Terms_visitor.folder + method fold_basic_arithmetic_operands: (basic_arithmetic_operands , 'a) fold = default + method fold_call_using_clause : (call_using_clause , 'a) fold = default + method fold_call_using_clause' : (call_using_clause with_loc, 'a) fold = default + method fold_call_using_by : (call_using_by , 'a) fold = default + method fold_date_time : (date_time , 'a) fold = default + method fold_divide_operands : (divide_operands , 'a) fold = default + method fold_file_option : (file_option , 'a) fold = default + method fold_multiply_operands : (multiply_operands , 'a) fold = default + method fold_open_mode : (open_mode , 'a) fold = default + method fold_position : (position , 'a) fold = default + method fold_raising : (raising , 'a) fold = default + method fold_read_direction : (read_direction , 'a) fold = default + method fold_read_lock_behavior : (read_lock_behavior , 'a) fold = default + method fold_retry_clause : (retry_clause , 'a) fold = default + method fold_search_condition : (search_condition , 'a) fold = default + method fold_sharing_mode : (sharing_mode , 'a) fold = default + method fold_stage : (stage , 'a) fold = default + method fold_advancing_phrase : (advancing_phrase , 'a) fold = default + method fold_write_target : (write_target , 'a) fold = default + method fold_procedure_range: 'x. ('x procedure_range, 'a) fold = default + (* SET *) + method fold_set_attribute_switch : (set_attribute_switch , 'a) fold = default + method fold_screen_attribute : (screen_attribute , 'a) fold = default + method fold_set_ambiguous_method : (set_ambiguous_method , 'a) fold = default + method fold_on_off : (on_off , 'a) fold = default + method fold_locale_category : (locale_category , 'a) fold = default + method fold_set_save_locale : (set_save_locale , 'a) fold = default + method fold_set_locale_target : (set_locale_target , 'a) fold = default + method fold_set_locale_source : (set_locale_source , 'a) fold = default + method fold_start_position : (start_position , 'a) fold = default + method fold_float_content : (float_content , 'a) fold = default + +end + +let fold_basic_arithmetic_operands (v: _ #folder) = + handle v#fold_basic_arithmetic_operands + ~continue:begin fun o x -> match o with + | ArithSimple { sources; targets } -> x + >> fold_list ~fold:fold_ident_or_numlit v sources + >> fold_rounded_idents v targets + | ArithGiving { sources; to_or_from_item; targets } -> x + >> fold_list ~fold:fold_ident_or_numlit v sources + >> fold_ident_or_numlit v to_or_from_item + >> fold_rounded_idents v targets + | ArithCorresponding { source; target } -> x + >> fold_qualname v source + >> fold_rounded_ident v target + end + +let fold_call_using_by (v: _ #folder) = + leaf v#fold_call_using_by + +let fold_call_using_clause (v: _ #folder) = + handle v#fold_call_using_clause + ~continue:begin fun { call_using_by; call_using_expr } x -> x + >> fold_option ~fold:fold_call_using_by v call_using_by + >> fold_option ~fold:fold_expr v call_using_expr + end + +let fold_call_using_clause' (v: _ #folder) = + handle' v#fold_call_using_clause' v ~fold:fold_call_using_clause + +let fold_date_time (v: _ #folder) = + leaf v#fold_date_time (* NB: only `bool` children: consider as a leaf *) + +let fold_divide_operands (v: _ #folder) = + handle v#fold_divide_operands + ~continue:begin fun o x -> match o with + | DivideInto { divisor; dividends } -> x + >> fold_ident_or_numlit v divisor + >> fold_rounded_idents v dividends + | DivideGiving { divisor; dividend; giving; into; remainder } -> x + >> fold_ident_or_numlit v divisor + >> fold_ident_or_numlit v dividend + >> fold_rounded_idents v giving + >> fold_bool v into + >> fold_option ~fold:fold_ident v remainder + end + +let fold_file_option (v: _ #folder) = + leaf v#fold_file_option + +let fold_multiply_operands (v: _ #folder) = + handle v#fold_multiply_operands + ~continue:begin fun o x -> match o with + | MultiplyBy { multiplier; multiplicand } -> x + >> fold_ident_or_numlit v multiplier + >> fold_rounded_idents v multiplicand + | MultiplyGiving { multiplier; multiplicand; targets } -> x + >> fold_ident_or_numlit v multiplier + >> fold_ident_or_numlit v multiplicand + >> fold_rounded_idents v targets + end + +let fold_open_mode (v: _ #folder) = + leaf v#fold_open_mode + +let fold_position (v: _ #folder) = + handle v#fold_position + ~continue:begin fun p x -> match p with + | LinePosition i + | ColumnPosition i -> x + >> fold_ident_or_intlit v i + | LineColumnPosition (i, j) -> x + >> fold_ident_or_intlit v i + >> fold_ident_or_intlit v j + end + +let fold_raising (v: _ #folder) = + handle v#fold_raising + ~continue:begin function + | RaisingIdent i -> fold_ident v i + | RaisingException n -> fold_name' v n + | RaisingLastException -> Fun.id + end + +let fold_read_direction (v: _ #folder) = + leaf v#fold_read_direction + +let fold_retry_clause (v: _ #folder) = + handle v#fold_retry_clause + ~continue:begin function + | RetryNTimes e + | RetryForNSeconds e -> fold_expr v e + | RetryForever -> Fun.id + end + +let fold_read_lock_behavior (v: _ #folder) = + handle v#fold_read_lock_behavior + ~continue:begin function + | ReadAdvancingOnLock + | ReadIgnoringLock -> Fun.id + | ReadRetry retry_clause -> fold_retry_clause v retry_clause + end + +let fold_search_condition (v: _ #folder) = + handle v#fold_search_condition + ~continue:begin fun cond x -> match cond with + | IsEqual { data_item; condition } -> x + >> fold_qualident v data_item + >> fold_expression v condition + | Cond ql -> x + >> fold_qualident v ql + end + +let fold_sharing_mode (v: _ #folder) = + leaf v#fold_sharing_mode + +let fold_stage (v: _ #folder) = + leaf v#fold_stage + +let fold_advancing_phrase (v: _ #folder) = + handle v#fold_advancing_phrase + ~continue:begin fun phrase x -> match phrase with + | AdvancingLines { stage; lines; ambiguous } -> x + >> fold_stage v stage + >> fold_ident_or_intlit v lines + >> fold_bool v ambiguous + | AdvancingPage { stage } -> x + >> fold_stage v stage + end + +let fold_start_position (v: _#folder) = + handle v#fold_start_position + ~continue:begin fun pos x -> match pos with + | StartPositionFirst + | StartPositionLast -> x + | StartPositionKey { operator; name; length } -> x + >> fold_relop v operator + >> fold_qualname v name + >> fold_option ~fold:fold_expression v length + end + +let fold_write_target (v: _ #folder) = + handle v#fold_write_target + ~continue:begin function + | WriteTargetName qn -> fold_qualname v qn + | WriteTargetFile name' -> fold_name' v name' + end + + +(* --- *) + +let fold_procedure_range (v: _ #folder) ~fold = + handle v#fold_procedure_range + ~continue:begin fun { procedure_start; procedure_end } x -> x + >> fold v procedure_start + >> fold_option ~fold v procedure_end + end + +(* SET *) + +let fold_screen_attribute (v: _ #folder) = + leaf v#fold_screen_attribute + +let fold_set_ambiguous_method (v: _ #folder) = + leaf v#fold_set_ambiguous_method + +let fold_on_off (v: _ #folder) = + leaf v#fold_on_off + +let fold_locale_category (v: _ #folder) = + leaf v#fold_locale_category + +let fold_set_save_locale (v: _ #folder) = + leaf v#fold_set_save_locale + +let fold_set_attribute_switch (v: _ #folder) = + handle v#fold_set_attribute_switch + ~continue:begin fun { set_attribute; set_attribute_switch_value } x -> x + >> fold_screen_attribute v set_attribute + >> fold_on_off v set_attribute_switch_value + end + +let fold_set_locale_target (v: _ #folder) = + handle v#fold_set_locale_target + ~continue:begin function + | SetLocaleTarget locale_category -> + fold_locale_category v locale_category + | SetLocaleTargetUserDefault -> Fun.id + end + +let fold_set_locale_source (v: _ #folder) = + handle v#fold_set_locale_source + ~continue:begin function + | SetLocaleSource id -> fold_ident v id + | SetLocaleSourceUserDefault + | SetLocaleSourceSystemDefault -> Fun.id + end + +let fold_float_content (v: _ #folder) = + handle v#fold_float_content + ~continue:begin function + | FarthestFromZero b + | NearestToZero b -> fold_bool v b + | FloatInfinity + | FloatNotANumber + | FloatNotANumberSignaling -> Fun.id + end diff --git a/src/lsp/cobol_ast/package.toml b/src/lsp/cobol_ast/package.toml new file mode 100644 index 000000000..c7b3dd71c --- /dev/null +++ b/src/lsp/cobol_ast/package.toml @@ -0,0 +1,75 @@ + +# name of package +name = "cobol_ast" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show ppx_deriving.ord" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_common = "version" +ppx_deriving = ">=5.2.1" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/cobol_ast/raw.ml b/src/lsp/cobol_ast/raw.ml new file mode 100644 index 000000000..a2ac6a2a3 --- /dev/null +++ b/src/lsp/cobol_ast/raw.ml @@ -0,0 +1,510 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ast + +module Misc_sections = struct + type informational_paragraphs = Ast.informational_paragraphs [@@deriving show] + type options_paragraph = Ast.options_paragraph [@@deriving show] + type environment_division = Ast.environment_division [@@deriving show] +end + +module Data_sections (Picture: Abstract.PICTURE) = struct + include Picture + + type picture_clause = + { + picture: Picture.picture; + picture_locale: locale_phrase option; + picture_depending: qualname with_loc option; + } + [@@deriving show] + + (* TODO (can be delayed): Unify some of the types (probably like for terms) *) + + type data_clause = + | DataAligned (* +COB2002 *) + | DataAnyLength (* +COB2002 *) + | DataBased (* +COB2002 *) + | DataBlankWhenZero + | DataConstantRecord (* +COB2002 *) + | DataOccurs of data_occurs_clause + | DataType of name with_loc (* +COB2002 *) + | DataValue of data_value_clause + | DataDynamicLength of (* +COB2002 *) + { + dynamic_length_structure_name: name with_loc option; + limit_is: integer option; + } + | DataExternal of external_clause + | DataGlobal + | DataGroupUsage of group_usage_clause (* +COB2002 *) + | DataJustified + | DataPicture of picture_clause with_loc + | DataProperty of property_clause with_loc (* +COB2002 *) + | DataRedefines of name with_loc + | DataSameAs of name with_loc (* +COB2002 *) + | DataSelectWhen of select_when_clause (* +COB2002 *) + | DataSign of sign_clause + | DataSynchronized of synchronized_clause + | DataTypedef of (* +COB2002 *) + { + strong: bool; + } + | DataUsage of usage_clause + | DataValidation of validation_clause (* +COB2002 *) + [@@deriving show] + + type report_group_clause = + | ReportType of report_type_clause + | ReportNextGroup of next_group_clause + | ReportLine of line_position list + | ReportPicture of picture_clause with_loc + | ReportUsage of report_screen_usage_clause + | ReportSign of sign_clause + | ReportJustified + | ReportColumn of + { + alignment: alignment; + position: column_position list; (* non-empty *) + } + | ReportBlankWhenZero + | ReportSource of + { + source: expression list; (* non-empty *) + rounding: rounding; + } + | ReportSum of + { + sum_of: sum_phrase list; (* non-empty *) + reset_on: report_data_name_or_final option; + rounding: rounding; + } + | ReportValue of literal + | ReportPresentWhen of condition (* +COB2002 *) + | ReportGroupIndicate + | ReportOccurs of (* +COB2002 *) + { + from: integer; + to_: integer option; + depending: qualname with_loc option; + step: integer option; + } + | ReportVarying of data_varying list (* +COB2002 *) + [@@deriving show] + + type screen_clause = + | ScreenAuto + | ScreenBlank of blank_clause + | ScreenBlankWhenZero + | ScreenErase of erase_clause + | ScreenFull + | ScreenGlobal + | ScreenJustified + | ScreenPicture of picture_clause with_loc + | ScreenUsage of report_screen_usage_clause + | ScreenRequired + | ScreenAttribute of screen_attribute_clause with_loc list (* non-empty *) + | ScreenColumn of screen_line_column_clause + | ScreenLine of screen_line_column_clause + | ScreenOccurs of integer + | ScreenSecure + | ScreenSign of sign_clause + | ScreenSourceDestination of source_destination_clause with_loc list (* non-empty *) + [@@deriving show] + + type data_item = + { + data_level: data_level with_loc; + data_name: data_name with_loc option; + data_clauses: data_clause with_loc list; + } + [@@deriving show] + + type screen_item = + { + screen_level: int; + screen_data_name: data_name with_loc option; + screen_clauses: screen_clause with_loc list; + } + [@@deriving show] + + type report_group_item = + { + report_level: int; + report_data_name: data_name with_loc option; + report_group_clauses: report_group_clause with_loc list; + } + [@@deriving show] + + type data_ = [`data] + type constant_ = [`const] + type rename_ = [`rename] + type condition_name_ = [`condition_name] + type screen_ = [`screen] + type report_group_ = [`report_group] + type _ item_descr = + | Constant: constant_item -> [>constant_] item_descr + | Data: data_item -> [>data_] item_descr + | Renames: rename_item -> [>rename_] item_descr + | CondName: condition_name_item -> [>condition_name_] item_descr + | Screen: screen_item -> [>screen_] item_descr + | ReportGroup: report_group_item -> [>report_group_] item_descr + + let pp_item_descr (type k) : k item_descr Pretty.printer = fun ppf -> function + | Constant c -> pp_constant_item ppf c + | Data d -> pp_data_item ppf d + | Renames r -> pp_rename_item ppf r + | CondName c -> pp_condition_name_item ppf c + | Screen s -> pp_screen_item ppf s + | ReportGroup r -> pp_report_group_item ppf r + + type data_item_descr = data_ item_descr + and constant_item_descr = constant_ item_descr + and working_item_descr = [constant_|data_| + rename_|condition_name_] item_descr + and report_item_descr = [constant_|report_group_] item_descr + and screen_item_descr = [constant_|screen_] item_descr + and any_item_descr = [constant_|data_|rename_|condition_name_| + report_group_|screen_] item_descr + let pp_data_item_descr = pp_item_descr + let pp_constant_item_descr = pp_item_descr + let pp_working_item_descr = pp_item_descr + let pp_report_item_descr = pp_item_descr + let pp_screen_item_descr = pp_item_descr + let pp_any_item_descr = pp_item_descr + + type working_storage_item_descr = working_item_descr [@@deriving show] + type linkage_item_descr = working_item_descr [@@deriving show] + type file_item_descr = working_item_descr [@@deriving show] + type communication_item_descr = working_item_descr [@@deriving show] + type local_storage_item_descr = working_item_descr [@@deriving show] + + type file_descr = + { + file_name: name with_loc; + file_clauses: file_clauses; + file_items: file_item_descr with_loc list; + } + [@@deriving show] + + and file_clauses = + | FileFD of file_fd_clause with_loc list + | FileSD of file_sd_clause with_loc list + [@@deriving show] + + and file_fd_clause = + | FileExternal of external_clause + | FileGlobal + | FileFormat of format_clause + | FileBlockContains of + { + from: integer; + to_: integer option; + characters_or_records: file_block_contents; + } + | FileRecord of record_clause + | FileLabel of label_clause + | FileValueOf of value_of_clause list + | FileData of file_data_clause + | FileLinage of file_linage_clause + | FileCodeSet of alphabet_specification + | FileReport of name with_loc list + [@@deriving show] + + and file_sd_clause = + | FileSDRecord of record_clause + | FileSDData of file_data_clause + | FileSDGlobal + [@@deriving show] + + + type communication_descr = + { + comm_name: name with_loc; + comm_clauses: comm_clause with_loc list; + comm_items: communication_item_descr with_loc list; + comm_direction: comm_direction; + } + [@@deriving show] + + and comm_direction = + | CommInput of { initial: bool; items: data_name with_loc list } + | CommOutput + | CommIO of { initial: bool; items: name with_loc list } + [@@deriving show] + + + type report_descr = + { + report_name: name with_loc; + report_clauses: report_clause with_loc list; + report_items: report_item_descr with_loc list; + } + [@@deriving show] + + + (* Actual sections *) + + type file_section = file_descr with_loc list [@@deriving show] + type working_storage_section = working_storage_item_descr with_loc list [@@deriving show] + type linkage_section = linkage_item_descr with_loc list [@@deriving show] + type communication_section = communication_descr with_loc list [@@deriving show] + type local_storage_section = local_storage_item_descr with_loc list [@@deriving show] + type report_section = report_descr with_loc list [@@deriving show] + type screen_section = screen_item_descr with_loc list [@@deriving show] + +end + +module Data_division (Data_sections: Abstract.DATA_SECTIONS) = struct + include Data_sections + + type data_division = + { + file_section: file_section option; + working_storage_section: working_storage_section option; + linkage_section: linkage_section option; + communication_section: communication_section option; + local_storage_section: local_storage_section option; + report_section: report_section option; + screen_section: screen_section option; + } + [@@deriving show] + +end + +module Statements = struct + type statement = Ast.statement [@@deriving show] + type statements = Ast.statements [@@deriving show] +end + +module Proc_division (Statements: Abstract.STATEMENTS) = struct + include Statements + + type procedure_division = + { + procedure_using_clauses: using_clause with_loc list; + procedure_returning: ident with_loc option; + procedure_raising_phrases: raising_phrase with_loc list; + procedure_declaratives: declarative with_loc list; + procedure_paragraphs: paragraph with_loc list; + } + [@@deriving show] + + and using_clause = + | UsingByReference of using_by_reference list + | UsingByValue of name with_loc list + [@@deriving show] + + and using_by_reference = + { + using_by_reference: name with_loc; + using_by_reference_optional: bool; + } + [@@deriving show] + + and raising_phrase = + { + raising: name with_loc; + raising_factory: bool; + } + [@@deriving show] + + and declarative = + { + declarative_name: name with_loc; + declarative_segment: integer option; + declarative_use: declarative_use option; + declarative_sentences: statements with_loc list; + } + [@@deriving show] + + and declarative_use = + | UseAfterFileException of + { + global: bool; + trigger: use_file_exception_on; + } + | UseBeforeReporting of + { + global: bool; + report_group: ident; + } + | UseForDebugging of use_for_debugging_target list + | UseAfterIOException of use_after_exception list + | UseAfterExceptionObject of name with_loc + [@@deriving show] + + and use_for_debugging_target = + | UseForDebuggingProcedure of + { + all: bool; + procedure: qualname; + } + | UseForDebuggingAllProcedures + [@@deriving show] + + and use_file_exception_on = + | UseFileExceptionOnNames of name with_loc list + | UseFileExceptionOnOpenMode of open_mode + [@@deriving show] + + and use_after_exception = + { + use_after_exception: name with_loc; + use_after_exception_on_files: name with_loc list; + } + [@@deriving show] + + and paragraph = + { + paragraph_name: name with_loc option; + paragraph_is_section: bool; + paragraph_segment: integer option; + paragraph_sentences: statements with_loc list; + } + [@@deriving show] + +end + +module Compilation_group + (Misc_sections: Abstract.MISC_SECTIONS) + (Data_division: Abstract.DATA_DIVISION) + (Proc_division: Abstract.PROC_DIVISION) = +struct + + include Misc_sections + include Data_division + include Proc_division + + type program_unit = + { + program_name: name with_loc; + program_as: strlit option; + program_level: program_level; + program_options: options_paragraph option; + program_env: environment_division with_loc option; + program_data: data_division with_loc option; + program_proc: procedure_division with_loc option; + program_end_name: name with_loc option; + } + [@@deriving show] + + and program_level = + | ProgramDefinition of + { (* Note: more general than before (allows nested prototypes): *) + kind: program_kind option; + has_identification_division: bool; + informational_paragraphs: informational_paragraphs; (* ~COB85, -COB2002 *) + nested_programs: program_unit with_loc list; + } + | ProgramPrototype + [@@deriving show] + + and program_kind = + | Common + | Initial + | Recursive + [@@deriving show] + + type function_unit = + { + function_name: name with_loc; + function_as: strlit option; + function_is_proto: bool; + function_options: options_paragraph option; + function_env: environment_division with_loc option; + function_data: data_division with_loc option; + function_proc: procedure_division option; + function_end_name: name with_loc; + } + [@@deriving show] + + type method_definition = + { + method_name: name with_loc; + method_kind: method_kind; + method_override: bool; + method_final: bool; + method_options: options_paragraph option; + method_env: environment_division with_loc option; + method_data: data_division with_loc option; + method_proc: procedure_division option; + method_end_name: name with_loc; + } + [@@deriving show] + + and method_kind = + | NamedMethod of { as_: strlit option } + | PropertyMethod of { kind: property_kind } + + type factory_definition = (* Note: could be merged with instance_definition *) + { + factory_implements: name with_loc list; + factory_options: options_paragraph option; + factory_env: environment_division with_loc option; + factory_data: data_division with_loc option; + factory_methods: method_definition with_loc list option; + } + [@@deriving show] + + type instance_definition = + { + instance_implements: name with_loc list; + instance_options: options_paragraph option; + instance_env: environment_division with_loc option; + instance_data: data_division with_loc option; + instance_methods: method_definition with_loc list option; + } + [@@deriving show] + + type class_definition = + { + class_name: name with_loc; + class_as: strlit option; + class_final: bool; + class_inherits: name with_loc list; + class_usings: name with_loc list; + class_options: options_paragraph option; + class_env: environment_division with_loc option; + class_factory: factory_definition option; + class_instance: instance_definition option; + class_end_name: name with_loc; + } + [@@deriving show] + + type interface_definition = + { + interface_name: name with_loc; + interface_as: strlit option; + interface_inherits: name with_loc list; + interface_usings: name with_loc list; + interface_options: options_paragraph option; + interface_env: environment_division with_loc option; + interface_methods: method_definition with_loc list option; + interface_end_name: name with_loc; + } + [@@deriving show] + + type compilation_unit = + | Program of program_unit + | Function of function_unit + | ClassDefinition of class_definition + | InterfaceDefinition of interface_definition + [@@deriving show] + + type compilation_group = + compilation_unit with_loc list + [@@deriving show] + +end diff --git a/src/lsp/cobol_ast/raw_compilation_group_visitor.ml b/src/lsp/cobol_ast/raw_compilation_group_visitor.ml new file mode 100644 index 000000000..a19774055 --- /dev/null +++ b/src/lsp/cobol_ast/raw_compilation_group_visitor.ml @@ -0,0 +1,213 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Terms_visitor + +let todo x = Cobol_common.Visitor.todo __FILE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ x + +(* --- *) + +module Make + (Misc_sections: Abstract.MISC_SECTIONS) + (Data_division: Abstract.DATA_DIVISION) + (Proc_division: Abstract.PROC_DIVISION) = +struct + + module Compilation_group = + Raw.Compilation_group (Misc_sections) (Data_division) (Proc_division) + + module Compilation_group_visitor = + Abstract_visitor.For_compilation_group (Compilation_group) + module Misc_sections_visitor = + Abstract_visitor.For_misc_sections (Misc_sections) + module Data_division_visitor = + Abstract_visitor.For_data_division (Data_division) + module Proc_division_visitor = + Abstract_visitor.For_proc_division (Proc_division) + + open Compilation_group + + class virtual ['a] folder = object + inherit ['a] Terms_visitor.folder + inherit ['a] Misc_sections_visitor.folder + inherit ['a] Data_division_visitor.folder + method fold_data_division' : (data_division with_loc , 'a) fold = default + inherit ['a] Proc_division_visitor.folder + method fold_procedure_division' : (procedure_division with_loc , 'a) fold = default + inherit ['a] Compilation_group_visitor.folder + method fold_program_unit : (program_unit , 'a) fold = default + method fold_program_unit' : (program_unit with_loc , 'a) fold = default + method fold_function_unit : (function_unit , 'a) fold = default + method fold_function_unit' : (function_unit with_loc , 'a) fold = default + method fold_method_definition : (method_definition , 'a) fold = default + method fold_factory_definition : (factory_definition , 'a) fold = default + method fold_instance_definition : (instance_definition , 'a) fold = default + method fold_class_definition' : (class_definition with_loc , 'a) fold = default + method fold_interface_definition' : (interface_definition with_loc, 'a) fold = default + method fold_compilation_unit' : (compilation_unit with_loc , 'a) fold = default + (* Additonal methods: *) + method fold_method_kind : (method_kind , 'a) fold = default + end + + let todo x = todo __MODULE__ x + let partial x = partial __MODULE__ x + + let fold_options_paragraph_opt (v: _ #folder) = + fold_option ~fold:(fun v -> v#continue_with_options_paragraph) v + + let fold_environment_division' (v: _ #folder) = + fold' ~fold:(fun v -> v#continue_with_environment_division) v + + let fold_environment_division'_opt (v: _ #folder) = + fold_option ~fold:fold_environment_division' v + + let fold_data_division' (v: _ #folder) = + handle' v#fold_data_division' v ~fold:(fun v -> v#continue_with_data_division) + + let fold_data_division'_opt (v: _ #folder) = + fold_option ~fold:fold_data_division' v + + let fold_procedure_division' (v: _ #folder) = + handle' v#fold_procedure_division' v + ~fold:(fun v -> v#continue_with_procedure_division) + + let fold_procedure_division_opt (v: _ #folder) = + fold_option ~fold:(fun v -> v#continue_with_procedure_division) v + + let fold_procedure_division'_opt (v: _ #folder) = + fold_option ~fold:fold_procedure_division' v + + let rec fold_program_unit (v: _ #folder) = + handle v#fold_program_unit + ~continue:begin fun { program_name; program_as; program_level; + program_options; program_env; program_data; + program_proc; program_end_name } x -> x + >> fold_name' v program_name + >> fold_strlit_opt v program_as + >> fold_options_paragraph_opt v program_options + >> fold_environment_division'_opt v program_env + >> fold_data_division'_opt v program_data + >> (fun x -> match program_level with + | ProgramPrototype -> x + | ProgramDefinition { kind; + has_identification_division; + informational_paragraphs = infos; + nested_programs } -> ignore kind; x + >> fold_bool v has_identification_division + >> v#continue_with_informational_paragraphs infos + >> fold_with_loc_list v nested_programs ~fold:fold_program_unit) + >> fold_procedure_division'_opt v program_proc + >> fold_name'_opt v program_end_name (* XXX: useful? *) + end + + let fold_program_unit' (v: _#folder) = + handle' v#fold_program_unit' ~fold:fold_program_unit v + + let fold_function_unit (v: _#folder) = + handle v#fold_function_unit + ~continue:begin fun { function_name; function_as; function_is_proto; + function_options; function_env; function_data; + function_proc; function_end_name } x -> x + >> fold_name' v function_name + >> fold_strlit_opt v function_as + >> fold_bool v function_is_proto (* XXX: useful? *) + >> fold_options_paragraph_opt v function_options + >> fold_environment_division'_opt v function_env + >> fold_data_division'_opt v function_data + >> fold_procedure_division_opt v function_proc + >> fold_name' v function_end_name (* XXX: useful? *) + end + + let fold_function_unit' (v: _#folder) = + handle' v#fold_function_unit' ~fold:fold_function_unit v + + let fold_method_kind (v: _#folder) = + handle v#fold_method_kind + ~continue:begin function + | NamedMethod { as_ } -> fold_strlit_opt v as_ + | PropertyMethod { kind } -> fold_property_kind v kind + end + + let fold_method_definition (v: _#folder) = + handle v#fold_method_definition + ~continue:begin fun { method_name; method_kind; + method_override; method_final; + method_options; method_env; method_data; + method_proc; method_end_name } x -> x + >> fold_name' v method_name + >> fold_method_kind v method_kind + >> fold_bool v method_override + >> fold_bool v method_final + >> fold_options_paragraph_opt v method_options + >> fold_environment_division'_opt v method_env + >> fold_data_division'_opt v method_data + >> fold_procedure_division_opt v method_proc + >> fold_name' v method_end_name (* XXX: useful? *) + end + + let fold_factory_definition (v: _#folder) = + handle v#fold_factory_definition + ~continue:begin fun { factory_implements; factory_options; factory_env; + factory_data; factory_methods } x -> x + >> fold_name'_list v factory_implements + >> fold_options_paragraph_opt v factory_options + >> fold_environment_division'_opt v factory_env + >> fold_data_division'_opt v factory_data + >> fold_option v factory_methods + ~fold:(fold_with_loc_list ~fold:fold_method_definition) + end + + let fold_instance_definition (v: _#folder) = + handle v#fold_instance_definition + ~continue:begin fun { instance_implements; instance_options; instance_env; + instance_data; instance_methods } x -> + ignore instance_env; + partial __LINE__ "fold_instance_definition" (); + x + >> fold_name'_list v instance_implements + >> fold_options_paragraph_opt v instance_options + >> fold_data_division'_opt v instance_data + >> fold_option v instance_methods + ~fold:(fold_with_loc_list ~fold:fold_method_definition) + end + + let fold_class_definition' (v: _#folder) = + handle v#fold_class_definition' + ~continue:(todo __LINE__ "fold_class_definition") + + let fold_interface_definition' (v: _#folder) = + handle v#fold_interface_definition' + ~continue:(todo __LINE__ "fold_interface_definition") + + let fold_compilation_unit' (v: _#folder) = + handle v#fold_compilation_unit' + ~continue:begin fun { payload; loc } -> match payload with + | Program d -> fold_program_unit' v (d &@ loc) + | Function d -> fold_function_unit' v (d &@ loc) + | ClassDefinition d -> fold_class_definition' v (d &@ loc) + | InterfaceDefinition d -> fold_interface_definition' v (d &@ loc) + end + + let fold_compilation_group (v: _#folder) = + handle v#fold_compilation_group + ~continue:(fold_list ~fold:fold_compilation_unit' v) + + (* let fold_compilation_group' (v: _#folder) = *) + (* handle' v#fold_compilation_group' ~fold:fold_compilation_group v *) + +end diff --git a/src/lsp/cobol_ast/raw_data_division_visitor.ml b/src/lsp/cobol_ast/raw_data_division_visitor.ml new file mode 100644 index 000000000..fb1b5d85c --- /dev/null +++ b/src/lsp/cobol_ast/raw_data_division_visitor.ml @@ -0,0 +1,62 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) + +let todo x = Cobol_common.Visitor.todo __FILE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ x + +(* --- *) + +module Make + (Data_sections: Abstract.DATA_SECTIONS) = +struct + + module Data_division = + Raw.Data_division (Data_sections) + + module Data_sections_visitor = + Abstract_visitor.For_data_sections (Data_sections) + module Data_division_visitor = + Abstract_visitor.For_data_division (Data_division) + + class virtual ['a] folder = object + inherit ['a] Terms_visitor.folder + inherit ['a] Data_sections_visitor.folder + inherit ['a] Data_division_visitor.folder + end + + let fold_data_division (v: _#folder) = + handle v#fold_data_division + ~continue:begin fun { file_section; working_storage_section; + linkage_section; communication_section; + local_storage_section; report_section; + screen_section } x -> x + >> fold_option v file_section + ~fold:(fun v -> v#continue_with_file_section) + >> fold_option v working_storage_section + ~fold:(fun v -> v#continue_with_working_storage_section) + >> fold_option v linkage_section + ~fold:(fun v -> v#continue_with_linkage_section) + >> fold_option v communication_section + ~fold:(fun v -> v#continue_with_communication_section) + >> fold_option v local_storage_section + ~fold:(fun v -> v#continue_with_local_storage_section) + >> fold_option v report_section + ~fold:(fun v -> v#continue_with_report_section) + >> fold_option v screen_section + ~fold:(fun v -> v#continue_with_screen_section) + end + +end diff --git a/src/lsp/cobol_ast/raw_data_sections_visitor.ml b/src/lsp/cobol_ast/raw_data_sections_visitor.ml new file mode 100644 index 000000000..7cf1c7241 --- /dev/null +++ b/src/lsp/cobol_ast/raw_data_sections_visitor.ml @@ -0,0 +1,441 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Terms_visitor + +let todo x = Cobol_common.Visitor.todo __FILE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ x + +(* --- *) + +module Make + (Picture: Abstract.PICTURE) = +struct + + module Data_sections = + Raw.Data_sections (Picture) + + module Picture_visitor = + Abstract_visitor.For_picture (Picture) + module Data_sections_visitor = + Abstract_visitor.For_data_sections (Data_sections) + + open Data_descr + open Data_sections + + class virtual ['a] folder = object + inherit ['a] Terms_visitor.folder + inherit ['a] Picture_visitor.folder + inherit ['a] Data_sections_visitor.folder + method fold_data_level : (data_level , 'a) fold = default + method fold_data_level' : (data_level with_loc , 'a) fold = default + method fold_data_name : (data_name , 'a) fold = default + method fold_data_name' : (data_name with_loc , 'a) fold = default + method fold_locale_phrase : (locale_phrase , 'a) fold = default + method fold_constant_value : (constant_value , 'a) fold = default + method fold_constant_value' : (constant_value with_loc , 'a) fold = default + method fold_constant_item : (constant_item , 'a) fold = default + method fold_constant_item' : (constant_item with_loc , 'a) fold = default + method fold_rename_item : (rename_item , 'a) fold = default + method fold_rename_item' : (rename_item with_loc , 'a) fold = default + method fold_condition_name_value: (condition_name_value , 'a) fold = default + method fold_condition_name_item : (condition_name_item , 'a) fold = default + method fold_condition_name_item': (condition_name_item with_loc, 'a) fold = default + method fold_picture_clause : (picture_clause , 'a) fold = default + method fold_picture_clause' : (picture_clause with_loc , 'a) fold = default + method fold_data_clause : (data_clause , 'a) fold = default + method fold_data_clause' : (data_clause with_loc , 'a) fold = default + method fold_data_item : (data_item , 'a) fold = default + method fold_data_item' : (data_item with_loc , 'a) fold = default + method fold_comm_channel : (comm_channel , 'a) fold = default + method fold_comm_clause : (comm_clause , 'a) fold = default + method fold_comm_clause' : (comm_clause with_loc , 'a) fold = default + method fold_comm_direction : (comm_direction , 'a) fold = default + method fold_communication_descr : (communication_descr , 'a) fold = default + method fold_communication_descr': (communication_descr with_loc, 'a) fold = default + method fold_report_group_clause : (report_group_clause , 'a) fold = default + method fold_report_group_clause': (report_group_clause with_loc, 'a) fold = default + method fold_report_group_item : (report_group_item , 'a) fold = default + method fold_report_group_item' : (report_group_item with_loc , 'a) fold = default + method fold_report_clause : (report_clause , 'a) fold = default + method fold_report_clause' : (report_clause with_loc , 'a) fold = default + method fold_report_descr : (report_descr , 'a) fold = default + method fold_report_descr' : (report_descr with_loc , 'a) fold = default + method fold_screen_clause : (screen_clause , 'a) fold = default + method fold_screen_clause' : (screen_clause with_loc , 'a) fold = default + method fold_screen_item : (screen_item , 'a) fold = default + method fold_screen_item' : (screen_item with_loc , 'a) fold = default + method fold_data_occurs_clause : (data_occurs_clause , 'a) fold = default + method fold_sort_spec : (sort_spec , 'a) fold = default + method fold_sort_direction : (sort_direction , 'a) fold = default + end + + let todo x = todo __MODULE__ x + and partial x = partial __MODULE__ x + + let fold_data_level (v: _ #folder) = + leaf v#fold_data_level + + let fold_data_level' (v: _ #folder) = + handle' v#fold_data_level' ~fold:fold_data_level v + + let fold_data_name (v: _ #folder) = + handle v#fold_data_name + ~continue:(function DataName n -> fold_name' v n | DataFiller -> Fun.id) + + let fold_data_name' (v: _ #folder) = + handle v#fold_data_name' + ~continue:(fold' ~fold:fold_data_name v) + + let fold_data_name'_opt (v: _ #folder) = + fold_option ~fold:fold_data_name' v + + let fold_locale_phrase (v: _ #folder) = + handle v#fold_locale_phrase + ~continue:begin fun { locale_name; locale_size } x -> x + >> fold_name'_opt v locale_name + >> fold_integer v locale_size + end + + let fold_locale_phrase_opt (v: _ #folder) = + fold_option ~fold:fold_locale_phrase v + + let fold_constant_value (v: _ #folder) = + handle v#fold_constant_value + ~continue:begin function + | ConstExpr e -> fold_expr v e + | ConstByteLength n | ConstLength n | ConstFrom n -> fold_name' v n + end + + let fold_constant_value' (v: _ #folder) = + handle' v#fold_constant_value' ~fold:fold_constant_value v + + let fold_constant_item (v: _ #folder) = + handle v#fold_constant_item + ~continue:begin fun { constant_level; constant_name; + constant_global; constant_value } x -> x + >> fold_data_level' v constant_level + >> fold_data_name'_opt v constant_name + >> fold_bool v constant_global + >> fold_constant_value' v constant_value + end + + let fold_constant_item' (v: _ #folder) = + handle' v#fold_constant_item' ~fold:fold_constant_item v + + let fold_rename_item (v: _ #folder) = + handle v#fold_rename_item + ~continue:begin fun { rename_level; rename_to; + rename_renamed; rename_through } x -> x + >> fold_data_level' v rename_level + >> fold_name' v rename_to + >> fold_qualname v rename_renamed + >> fold_qualname_opt v rename_through + end + + let fold_rename_item' (v: _ #folder) = + handle' v#fold_rename_item' ~fold:fold_rename_item v + + let fold_condition_name_value (v: _ #folder) = + handle v#fold_condition_name_value + ~continue:begin fun { condition_name_value; condition_name_through } x -> x + >> fold_literal v condition_name_value + >> fold_literal_opt v condition_name_through + end + + let fold_condition_name_item (v: _ #folder) = + handle v#fold_condition_name_item + ~continue:begin fun { condition_name_level; (*is always 88*) + condition_name; condition_name_values; + condition_name_alphabet; + condition_name_when_false } x -> x + >> fold_data_level' v condition_name_level (*or ignore*) + >> fold_name' v condition_name + >> fold_list ~fold:fold_condition_name_value v condition_name_values + >> fold_name'_opt v condition_name_alphabet + >> fold_literal_opt v condition_name_when_false + end + + let fold_condition_name_item' (v: _ #folder) = + handle' v#fold_condition_name_item' ~fold:fold_condition_name_item v + + let fold_picture_clause (v: _ #folder) = + handle v#fold_picture_clause + ~continue:begin fun { picture; picture_locale; picture_depending } x -> x + >> v#continue_with_picture picture + >> fold_locale_phrase_opt v picture_locale + >> fold_qualname'_opt v picture_depending + end + + let fold_picture_clause' (v: _ #folder) = + handle' v#fold_picture_clause' ~fold:fold_picture_clause v + + let fold_sort_direction (v: _ #folder) = leaf v#fold_sort_direction + + let fold_sort_spec (v: _ #folder) = + handle v#fold_sort_spec + ~continue:begin fun { sort_key_direction; sort_key_names } x -> x + >> fold_sort_direction v sort_key_direction + >> fold_list ~fold:fold_qualname v sort_key_names + end + + let fold_data_occurs_clause (v: _ #folder) = + handle v#fold_data_occurs_clause + ~continue:begin fun c x -> match c with + | OccursFixed { times; key_is; indexed_by } -> x + >> fold_integer v times + >> fold_list ~fold:fold_sort_spec v key_is + >> fold_name'_list v indexed_by + | OccursDepending { from; to_; depending; + key_is; indexed_by } -> x + >> fold_integer v from + >> fold_integer v to_ + >> fold_qualname' v depending + >> fold_list ~fold:fold_sort_spec v key_is + >> fold_name'_list v indexed_by + | OccursDynamic { capacity_in; from; to_; + initialized; key_is; indexed_by } -> x + >> fold_name'_opt v capacity_in + >> fold_integer_opt v from + >> fold_integer_opt v to_ + >> fold_bool v initialized + >> fold_list ~fold:fold_sort_spec v key_is + >> fold_name'_list v indexed_by + end + + let fold_data_clause (v: _ #folder) = + handle v#fold_data_clause + ~continue:begin function + | DataAligned + | DataAnyLength + | DataBased + | DataBlankWhenZero + | DataConstantRecord + | DataGlobal + | DataJustified -> Fun.id + | DataOccurs c -> fold_data_occurs_clause v c + | _ -> partial __LINE__ "fold_data_clause" + end + + let fold_data_clause' (v: _ #folder) = + handle' v#fold_data_clause' ~fold:fold_data_clause v + + let fold_data_clauses (v: _ #folder) = + fold_list ~fold:fold_data_clause' v + + let fold_data_item (v: _ #folder) = + handle v#fold_data_item + ~continue:begin fun { data_level; data_name; data_clauses } x -> x + >> fold_data_level' v data_level + >> fold_data_name'_opt v data_name + >> fold_data_clauses v data_clauses + end + + let fold_data_item' (v: _ #folder) = + handle' v#fold_data_item' ~fold:fold_data_item v + + let fold_working_item_descr (v: _ #folder) : working_item_descr -> _ = function + | Constant c -> fold_constant_item v c + | Renames r -> fold_rename_item v r + | CondName c -> fold_condition_name_item v c + | Data e -> fold_data_item v e + + let fold_working_item_descr' (v: _ #folder) + : working_item_descr with_loc -> _ = fun d -> match ~&d with + | Constant c -> fold_constant_item' v (c &@<- d) + | Renames r -> fold_rename_item' v (r &@<- d) + | CondName c -> fold_condition_name_item' v (c &@<- d) + | Data e -> fold_data_item' v (e &@<- d) + + let fold_working_storage_item_descr = fold_working_item_descr + let fold_working_storage_item_descr' = fold_working_item_descr' + let fold_working_storage_section (v: _ #folder) = + handle v#fold_working_storage_section + ~continue:(fold_list ~fold:fold_working_storage_item_descr' v) + + let fold_linkage_item_descr = fold_working_item_descr + let fold_linkage_item_descr' = fold_working_item_descr' + let fold_linkage_section (v: _ #folder) = + handle v#fold_linkage_section + ~continue:(fold_list ~fold:fold_linkage_item_descr' v) + + let fold_file_item_descr = fold_working_item_descr + let fold_file_item_descr' = fold_working_item_descr' + let fold_file_section (v: _ #folder) = + handle v#fold_file_section + ~continue:(todo __LINE__ "fold_file_section") + + let fold_comm_channel (v: _ #folder) = + leaf v#fold_comm_channel + + let fold_comm_clause (v: _ #folder) = + handle v#fold_comm_clause + ~continue:begin fun c x -> match c with + | CommSymbolic (c, n) -> x + >> fold_comm_channel v c + >> fold_name' v n + | CommDestinationTable (i, nl) -> x + >> fold_integer v i + >> fold_name'_list v nl + | CommDestinationCount n + | CommMessageCount n + | CommMessageDate n + | CommMessageTime n + | CommTextLength n + | CommStatusKey n + | CommEndKey n + | CommErrorKey n -> x + >> fold_name' v n + end + + let fold_comm_clause' (v: _ #folder) = + handle' v#fold_comm_clause' ~fold:fold_comm_clause v + + let fold_comm_direction (v: _ #folder) = + handle v#fold_comm_direction + ~continue:begin fun d x -> match d with + | CommOutput -> x + | CommInput { initial; items } -> x + >> fold_bool v initial + >> fold_list ~fold:fold_data_name' v items + | CommIO { initial; items } -> x + >> fold_bool v initial + >> fold_name'_list v items + end + + let fold_communication_item_descr = fold_working_item_descr + let fold_communication_item_descr' = fold_working_item_descr' + let fold_communication_descr (v: _ #folder) = + handle v#fold_communication_descr + ~continue:begin fun { comm_name; comm_clauses; + comm_items; comm_direction } x -> x + >> fold_name' v comm_name + >> fold_list ~fold:fold_comm_clause' v comm_clauses + >> fold_list ~fold:fold_communication_item_descr' v comm_items + >> fold_comm_direction v comm_direction + end + + let fold_communication_descr' (v: _ #folder) = + handle' v#fold_communication_descr' ~fold:fold_communication_descr v + + let fold_communication_section (v: _ #folder) = + handle v#fold_communication_section + ~continue:(fold_list ~fold:fold_communication_descr' v) + + let fold_local_storage_item_descr = fold_working_item_descr + let fold_local_storage_item_descr' = fold_working_item_descr' + let fold_local_storage_section (v: _ #folder) = + handle v#fold_local_storage_section + ~continue:(fold_list ~fold:fold_local_storage_item_descr' v) + + let fold_report_group_clause (v: _ #folder) = + handle v#fold_report_group_clause + ~continue:(todo __LINE__ "fold_report_group_clause") + + let fold_report_group_clause' (v: _ #folder) = + handle' v#fold_report_group_clause' ~fold:fold_report_group_clause v + + let fold_report_group_item (v: _ #folder) = + handle v#fold_report_group_item + ~continue:begin fun { report_level; report_data_name; + report_group_clauses } x -> x + >> fold_int v report_level + >> fold_data_name'_opt v report_data_name + >> fold_list ~fold:fold_report_group_clause' v report_group_clauses + end + + let fold_report_group_item' (v: _ #folder) = + handle' v#fold_report_group_item' ~fold:fold_report_group_item v + + let fold_report_item_descr (v: _ #folder) : report_item_descr -> _ = function + | Constant c -> fold_constant_item v c + | ReportGroup r -> fold_report_group_item v r + + let fold_report_item_descr' (v: _ #folder) + : report_item_descr with_loc -> _ = fun d -> match ~&d with + | Constant c -> fold_constant_item' v (c &@<- d) + | ReportGroup r -> fold_report_group_item' v (r &@<- d) + + let fold_report_clause (v: _ #folder) = + handle v#fold_report_clause + ~continue:begin fun r x -> match r with + | Global -> x + | Code i -> fold_ident v i x + | Control { final; controls } -> x + >> fold_bool v final + >> fold_name'_list v controls + | PageLimit { lines; columns; heading; first_detail; + last_control_heading; last_detail; footing } -> x + >> fold_integer_opt v lines + >> fold_integer_opt v columns + >> fold_integer_opt v heading + >> fold_integer_opt v first_detail + >> fold_integer_opt v last_control_heading + >> fold_integer_opt v last_detail + >> fold_integer_opt v footing + end + + let fold_report_clause' (v: _ #folder) = + handle' v#fold_report_clause' ~fold:fold_report_clause v + + let fold_report_descr (v: _ #folder) = + handle v#fold_report_descr + ~continue:begin fun { report_name; report_clauses; report_items } x -> x + >> fold_name' v report_name + >> fold_list ~fold:fold_report_clause' v report_clauses + >> fold_list ~fold:fold_report_item_descr' v report_items + end + + let fold_report_descr' (v: _ #folder) = + handle' v#fold_report_descr' ~fold:fold_report_descr v + + let fold_report_section (v: _ #folder) = + handle v#fold_report_section + ~continue:(fold_list ~fold:fold_report_descr' v) + + let fold_screen_clause (v: _ #folder) = + handle v#fold_screen_clause + ~continue:(todo __LINE__ "fold_screen_clause") + + let fold_screen_clause' (v: _ #folder) = + handle' v#fold_screen_clause' ~fold:fold_screen_clause v + + let fold_screen_item (v: _ #folder) = + handle v#fold_screen_item + ~continue:begin fun { screen_level; screen_data_name; screen_clauses } x -> x + >> fold_int v screen_level + >> fold_data_name'_opt v screen_data_name + >> fold_list ~fold:fold_screen_clause' v screen_clauses + end + + let fold_screen_item' (v: _ #folder) = + handle' v#fold_screen_item' ~fold:fold_screen_item v + + let fold_screen_item_descr (v: _ #folder) : screen_item_descr -> _ = function + | Constant c -> fold_constant_item v c + | Screen s -> fold_screen_item v s + + let fold_screen_item_descr' (v: _ #folder) + : screen_item_descr with_loc -> _ = fun d -> match ~&d with + | Constant c -> fold_constant_item' v (c &@<- d) + | Screen s -> fold_screen_item' v (s &@<- d) + + let fold_screen_section (v: _ #folder) = + handle v#fold_screen_section + ~continue:(fold_list ~fold:fold_screen_item_descr' v) + +end diff --git a/src/lsp/cobol_ast/raw_misc_sections_visitor.ml b/src/lsp/cobol_ast/raw_misc_sections_visitor.ml new file mode 100644 index 000000000..983164801 --- /dev/null +++ b/src/lsp/cobol_ast/raw_misc_sections_visitor.ml @@ -0,0 +1,236 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Terms_visitor + +let todo x = Cobol_common.Visitor.todo __FILE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ x + +(* --- *) + +module Make = struct + + module Misc_sections_visitor = + Abstract_visitor.For_misc_sections (Raw.Misc_sections) + + open Misc_descr + + class virtual ['a] folder = object + inherit ['a] Terms_visitor.folder + inherit ['a] Misc_sections_visitor.folder + method fold_options_clause: (options_clause, 'a) fold = default + method fold_configuration_section: (configuration_section, 'a) fold = default + method fold_special_names_paragraph: (special_names_paragraph, 'a) fold = default + method fold_special_names_clause: (special_names_clause, 'a) fold = default + method fold_special_names_clause': (special_names_clause with_loc, 'a) fold = default + method fold_repository_paragraph: (repository_paragraph, 'a) fold = default + method fold_specifier: (specifier, 'a) fold = default + method fold_expands: (expands, 'a) fold = default + method fold_select: (select, 'a) fold = default + method fold_select_clause: (select_clause, 'a) fold = default + method fold_file_control_paragraph: (file_control_paragraph, 'a) fold = default + method fold_io_control_paragraph: (io_control_paragraph, 'a) fold = default + method fold_io_control_entry: (io_control_entry, 'a) fold = default + method fold_rerun_clause: (rerun_clause, 'a) fold = default + method fold_rerun_frequency: (rerun_frequency, 'a) fold = default + method fold_same_area_clause: (same_area_clause, 'a) fold = default + method fold_area_source: (area_source, 'a) fold = default + method fold_multiple_file_clause: (multiple_file_clause, 'a) fold = default + method fold_file_portion: (file_portion, 'a) fold = default + method fold_input_output_section: (input_output_section, 'a) fold = default + method fold_alphabet_specification: (alphabet_specification, 'a) fold = default + end + + let todo x = todo __MODULE__ x + and partial x = partial __MODULE__ x + + let fold_options_clause (v: _ #folder) = + handle v#fold_options_clause + ~continue:(todo __LINE__ "fold_options_clause") + + let fold_select_clause (v: _ #folder) = + handle v#fold_select_clause + ~continue:(todo __LINE__ "fold_select_clause") + + let fold_select (v: _ #folder) = + handle v#fold_select + ~continue:begin fun { select_optional; select_name; select_clauses } x -> x + >> fold_bool v select_optional + >> fold_name' v select_name + >> fold_with_loc_list ~fold:fold_select_clause v select_clauses + end + + let fold_file_control_paragraph (v: _ #folder) = + handle v#fold_file_control_paragraph + ~continue:(fold_list ~fold:fold_select v) + + let fold_rerun_frequency (v: _ #folder) = + handle v#fold_rerun_frequency + ~continue:begin function + | RerunEndOf n | RerunCond n -> fold_name' v n + | RerunRecords (i, n) -> fun x -> x >> fold_integer v i >> fold_name' v n + | RerunClockUnits i -> fold_integer v i + end + + let fold_rerun_clause (v: _ #folder) = + handle v#fold_rerun_clause + ~continue:begin fun { rerun_on; rerun_every } x -> x + >> fold_name'_opt v rerun_on + >> fold_rerun_frequency v rerun_every + end + + let fold_area_source (v: _ #folder) = + leaf v#fold_area_source + + let fold_same_area_clause (v: _ #folder) = + handle v#fold_same_area_clause + ~continue:begin fun { same_area_source; + same_area_file_name; + same_area_file_names } x -> x + >> fold_area_source v same_area_source + >> fold_name' v same_area_file_name + >> fold_name'_list v same_area_file_names + end + + let fold_file_portion (v: _ #folder) = + handle v#fold_file_portion + ~continue:begin fun { file_portion_name; file_portion_position } x -> x + >> fold_name' v file_portion_name + >> fold_integer_opt v file_portion_position + end + + let fold_multiple_file_clause (v: _ #folder) = + handle v#fold_multiple_file_clause + ~continue:(fold_list ~fold:fold_file_portion v) + + let fold_io_control_entry (v: _ #folder) = + handle v#fold_io_control_entry + ~continue:begin fun { io_control_rerun_clauses; + io_control_same_area_clauses; + io_control_multiple_file_clauses } x -> x + >> fold_with_loc_list v io_control_rerun_clauses + ~fold:fold_rerun_clause + >> fold_with_loc_list v io_control_same_area_clauses + ~fold:fold_same_area_clause + >> fold_with_loc_list v io_control_multiple_file_clauses + ~fold:fold_multiple_file_clause + end + + let fold_io_control_paragraph (v: _ #folder) = + handle v#fold_io_control_paragraph + ~continue:(fold_option ~fold:fold_io_control_entry v) + + let fold_input_output_section (v: _ #folder) = + handle v#fold_input_output_section + ~continue:begin fun { file_control_paragraph; io_control_paragraph } x -> x + >> fold_option v file_control_paragraph + ~fold:fold_file_control_paragraph + >> fold_option v io_control_paragraph + ~fold:fold_io_control_paragraph + end + + (* --- *) + + let fold_informational_paragraphs (v: _ #folder) = + handle v#fold_informational_paragraphs + ~continue:begin fun { author; installation; date_written; + date_compiled; security } x -> x + >> fold_string'_opt v author + >> fold_string'_opt v installation + >> fold_string'_opt v date_written + >> fold_string'_opt v date_compiled + >> fold_string'_opt v security + end + + let fold_options_paragraph (v: _ #folder) = + handle v#fold_options_paragraph + ~continue:(fold_with_loc_list ~fold:fold_options_clause v) + + let fold_expands (v: _ #folder) = + handle v#fold_expands + ~continue:begin fun { expands_name; expands_using } x -> x + >> fold_name' v expands_name + >> fold_name'_list v expands_using + end + + let fold_specifier (v: _ #folder) = + handle v#fold_specifier + ~continue:begin fun s x -> match s with + | ClassSpecifier { name; external_name; expands } + | InterfaceSpecifier { name; external_name; expands } -> x + >> fold_name' v name + >> fold_strlit_opt v external_name + >> fold_option ~fold:fold_expands v expands + | UserFunctionSpecifier { name; external_name } + | ProgramSpecifier { name; external_name } + | PropertySpecifier { name; external_name } -> x + >> fold_name' v name + >> fold_strlit_opt v external_name + | IntrinsicFunctionSpecifier names -> x + >> fold_name'_list v names + | IntrinsicFunctionAllSpecifier -> + x + end + + let fold_repository_paragraph (v: _ #folder) = + handle v#fold_repository_paragraph + ~continue:(fold_list ~fold:fold_specifier v) + + let fold_special_names_clause (v: _ #folder) = + handle v#fold_special_names_clause + ~continue:begin fun c x -> match c with + | DecimalPointIsComma -> x + | CurrencySign { sign; picture_symbol } -> x + >> fold_strlit v sign + >> fold_strlit_opt v picture_symbol + | _ -> partial __LINE__ "fold_special_names_clause" x + end + + let fold_special_names_clause' (v: _ #folder) = + handle' v#fold_special_names_clause' ~fold:fold_special_names_clause v + + let fold_special_names_paragraph (v: _ #folder) = + handle v#fold_special_names_paragraph + ~continue:(fold_list ~fold:fold_special_names_clause' v) + + let fold_configuration_section (v: _ #folder) = + handle v#fold_configuration_section + ~continue:begin fun { source_computer_paragraph; + object_computer_paragraph; + special_names_paragraph; + repository_paragraph } x -> + ignore source_computer_paragraph; + ignore object_computer_paragraph; + ignore special_names_paragraph; + x + >> partial __LINE__ "fold_configuration_section" + >> fold_option ~fold:fold_repository_paragraph v repository_paragraph + end + + let fold_environment_division (v: _ #folder) = + handle v#fold_environment_division + ~continue:begin fun { env_configuration; env_input_output } x -> x + >> fold_option ~fold:fold_configuration_section v env_configuration + >> fold_option ~fold:fold_input_output_section v env_input_output + end + + let fold_alphabet_specification (v: _ #folder) = + handle v#fold_alphabet_specification + ~continue:begin fun { alphanumeric; national } x -> x + >> fold_option ~fold:fold_name' v alphanumeric + >> fold_option ~fold:fold_name' v national + end +end diff --git a/src/lsp/cobol_ast/raw_proc_division_visitor.ml b/src/lsp/cobol_ast/raw_proc_division_visitor.ml new file mode 100644 index 000000000..50314b951 --- /dev/null +++ b/src/lsp/cobol_ast/raw_proc_division_visitor.ml @@ -0,0 +1,167 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Terms_visitor +open Operands_visitor + +let todo x = Cobol_common.Visitor.todo __FILE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ x + +(* --- *) + +module Make + (Statements: Abstract.STATEMENTS) = +struct + + module Proc_division = + Raw.Proc_division (Statements) + + module Statements_visitor = + Abstract_visitor.For_statements (Statements) + module Proc_division_visitor = + Abstract_visitor.For_proc_division (Proc_division) + + open Proc_division + + class virtual ['a] folder = object + inherit ['a] Operands_visitor.folder (* inherits Terms_visitor.folder *) + inherit ['a] Statements_visitor.folder + inherit ['a] Proc_division_visitor.folder + method fold_declarative : (declarative , 'a) fold = default + method fold_declarative' : (declarative with_loc , 'a) fold = default + method fold_paragraph : (paragraph , 'a) fold = default + method fold_paragraph' : (paragraph with_loc , 'a) fold = default + method fold_using_clause : (using_clause , 'a) fold = default + method fold_using_clause' : (using_clause with_loc , 'a) fold = default + method fold_using_by_reference : (using_by_reference , 'a) fold = default + method fold_declarative_use : (declarative_use , 'a) fold = default + method fold_use_after_exception : (use_after_exception , 'a) fold = default + method fold_use_for_debugging_target: (use_for_debugging_target, 'a) fold = default + method fold_raising_phrase : (raising_phrase , 'a) fold = default + method fold_raising_phrase' : (raising_phrase with_loc , 'a) fold = default + end + + let todo x = todo __MODULE__ x + and partial x = partial __MODULE__ x + + let fold_use_exception_on (v: _ #folder) = function + | UseFileExceptionOnNames n -> fold_name'_list v n + | UseFileExceptionOnOpenMode m -> fold_open_mode v m + + let fold_use_for_debugging_target (v: _ #folder) = + handle v#fold_use_for_debugging_target + ~continue:begin fun t x -> match t with + | UseForDebuggingProcedure { all; procedure } -> x + >> fold_bool v all + >> fold_qualname v procedure + | UseForDebuggingAllProcedures -> x + end + + let fold_use_after_exception (v: _ #folder) = + handle v#fold_use_after_exception + ~continue:begin fun { use_after_exception; + use_after_exception_on_files } x -> x + >> fold_name' v use_after_exception + >> fold_name'_list v use_after_exception_on_files + end + + let fold_declarative_use (v: _ #folder) = + handle v#fold_declarative_use + ~continue:begin fun u x -> match u with + | UseAfterFileException { global; trigger } -> x + >> fold_bool v global + >> fold_use_exception_on v trigger + | UseBeforeReporting { global; report_group } -> x + >> fold_bool v global + >> fold_ident v report_group + | UseForDebugging l -> x + >> fold_list ~fold:fold_use_for_debugging_target v l + | UseAfterIOException l -> x + >> fold_list ~fold:fold_use_after_exception v l + | UseAfterExceptionObject n -> x + >> fold_name' v n + end + + let fold_declarative (v: _ #folder) = + handle v#fold_declarative + ~continue:begin fun { declarative_name; declarative_segment; + declarative_use; declarative_sentences } x -> x + >> fold_name' v declarative_name + >> fold_integer_opt v declarative_segment + >> fold_option ~fold:fold_declarative_use v declarative_use + >> fold_list ~fold:(fun v -> v#continue_with_statements') v declarative_sentences + end + + let fold_declarative' (v: _ #folder) = + handle' v#fold_declarative' ~fold:fold_declarative v + + let fold_paragraph (v: _ #folder) = + handle v#fold_paragraph + ~continue:begin fun { paragraph_name; paragraph_is_section; + paragraph_segment; paragraph_sentences } x -> + ignore paragraph_is_section; x + >> fold_name'_opt v paragraph_name + >> fold_integer_opt v paragraph_segment + >> fold_list ~fold:(fun v -> v#continue_with_statements') v paragraph_sentences + end + + let fold_paragraph' (v: _ #folder) = + handle' v#fold_paragraph' ~fold:fold_paragraph v + + let fold_using_by_reference (v: _ #folder) = + handle v#fold_using_by_reference + ~continue:begin fun { using_by_reference; + using_by_reference_optional } x -> x + >> fold_name' v using_by_reference + >> fold_bool v using_by_reference_optional + end + + let fold_using_clause (v: _ #folder) = + handle v#fold_using_clause + ~continue:begin function + | UsingByReference l -> fold_list ~fold:fold_using_by_reference v l + | UsingByValue l -> fold_name'_list v l + end + + let fold_using_clause' (v: _ #folder) = + handle' v#fold_using_clause' ~fold:fold_using_clause v + + let fold_raising_phrase (v: _ #folder) = + handle v#fold_raising_phrase + ~continue:begin fun { raising; raising_factory } x -> x + >> fold_name' v raising + >> fold_bool v raising_factory + end + + let fold_raising_phrase' (v: _ #folder) = + handle' v#fold_raising_phrase' ~fold:fold_raising_phrase v + + let fold_procedure_division (v: _ #folder) = + handle v#fold_procedure_division + ~continue:begin fun { procedure_using_clauses; procedure_returning; + procedure_raising_phrases; procedure_declaratives; + procedure_paragraphs } x -> x + >> fold_list ~fold:fold_using_clause' v procedure_using_clauses + >> fold_ident'_opt v procedure_returning + >> fold_list ~fold:fold_raising_phrase' v procedure_raising_phrases + >> fold_list ~fold:fold_declarative' v procedure_declaratives + >> fold_list ~fold:fold_paragraph' v procedure_paragraphs + end + + let fold_procedure_division' (v: _ #folder) = + handle' v#fold_procedure_division' ~fold:fold_procedure_division v + +end diff --git a/src/lsp/cobol_ast/raw_statements_visitor.ml b/src/lsp/cobol_ast/raw_statements_visitor.ml new file mode 100644 index 000000000..534d4f7b9 --- /dev/null +++ b/src/lsp/cobol_ast/raw_statements_visitor.ml @@ -0,0 +1,956 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.INFIX +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Terms_visitor +open Operands_visitor + +let todo x = Cobol_common.Visitor.todo __FILE__ x +let partial x = Cobol_common.Visitor.partial __FILE__ x + +(* --- *) + +module Make = struct + + module Statements_visitor = + Abstract_visitor.For_statements (Raw.Statements) + + open Terms + open Operands + open Simple_statements + open Branching_statements + + class virtual ['a] folder = object + inherit ['a] Operands_visitor.folder (* inherits Terms_visitor.folder *) + inherit ['a] Statements_visitor.folder + + (* Statement-specific operands; shared ones should be in + Operands_visitor. *) + method fold_perform_mode : (perform_mode , 'a) fold = default + method fold_varying_phrase : (varying_phrase , 'a) fold = default + method fold_varying_phrase' : (varying_phrase with_loc , 'a) fold = default + method fold_allocate_kind : (allocate_kind , 'a) fold = default + method fold_alter_operands' : (alter_operands with_loc , 'a) fold = default + method fold_call_prefix : (call_prefix , 'a) fold = default + method fold_call_proto : (call_proto , 'a) fold = default + method fold_close_format : (close_format , 'a) fold = default + method fold_close_phrase : (close_phrase , 'a) fold = default + (* method fold_display_target' : (display_target with_loc , 'a) fold = default *) + method fold_init_data_category : (init_data_category , 'a) fold = default + method fold_init_replacing : (init_replacing , 'a) fold = default + method fold_named_file_option : (named_file_option , 'a) fold = default + (*for inspect*) + method fold_inspect_spec : (inspect_spec , 'a) fold = default + method fold_tallying : (tallying , 'a) fold = default + method fold_tallying_clause' : (tallying_clause with_loc, 'a) fold = default + method fold_tallying_spec : (tallying_spec , 'a) fold = default + method fold_replacing : (replacing , 'a) fold = default + method fold_replacing_clause : (replacing_clause , 'a) fold = default + method fold_replacing_range_spec: (replacing_range_spec , 'a) fold = default + method fold_converting : (converting , 'a) fold = default + method fold_inspect_where : (inspect_where , 'a) fold = default + method fold_merge_or_sort_target: (merge_or_sort_target , 'a) fold = default + method fold_open_phrase : (open_phrase , 'a) fold = default + method fold_read_error : (read_error , 'a) fold = default + method fold_stop_run : (stop_run , 'a) fold = default + method fold_stop_kind : (stop_kind , 'a) fold = default + method fold_string_source : (string_source , 'a) fold = default + method fold_string_delimiter : (string_delimiter , 'a) fold = default + method fold_evaluate_branch : (evaluate_branch , 'a) fold = default + method fold_selection_subject : (selection_subject , 'a) fold = default + method fold_selection_object : (selection_object , 'a) fold = default + method fold_set_switch_spec : (set_switch_spec , 'a) fold = default + method fold_set_condition_spec : (set_condition_spec , 'a) fold = default + method fold_unstring_delimiter : (unstring_delimiter , 'a) fold = default + method fold_unstring_target : (unstring_target , 'a) fold = default + method fold_write_error : (write_error , 'a) fold = default + + (* high-level structures and branches *) + method fold_handler' : (handler with_loc , 'a) fold = default + method fold_dual_handler : (dual_handler , 'a) fold = default + method fold_perform_target : (perform_target , 'a) fold = default + method fold_call_error_handler : (call_error_handler , 'a) fold = default + method fold_search_when_clause' : (search_when_clause with_loc, 'a) fold = default + method fold_search_spec : (search_spec , 'a) fold = default + method fold_read_error_handler : (read_error * dual_handler , 'a) fold = default + method fold_write_error_handler : (write_error * dual_handler , 'a) fold = default + + (* Individial statements with locations *) + method fold_accept' : (accept_stmt with_loc , 'a) fold = default + method fold_allocate' : (allocate_stmt with_loc , 'a) fold = default + method fold_alter' : (alter_stmt with_loc , 'a) fold = default + method fold_add' : (basic_arithmetic_stmt with_loc, 'a) fold = default + method fold_call' : (call_stmt with_loc , 'a) fold = default + method fold_cancel' : (ident_or_strlit list with_loc , 'a) fold = default + method fold_close' : (close_stmt with_loc , 'a) fold = default + method fold_compute' : (compute_stmt with_loc , 'a) fold = default + method fold_delete' : (delete_stmt with_loc , 'a) fold = default + method fold_display' : (display_stmt with_loc , 'a) fold = default + method fold_divide' : (divide_stmt with_loc , 'a) fold = default + method fold_exit' : (exit_stmt with_loc , 'a) fold = default + method fold_evaluate' : (evaluate_stmt with_loc , 'a) fold = default + method fold_free' : (name with_loc list with_loc , 'a) fold = default + method fold_generate' : (name with_loc with_loc , 'a) fold = default + method fold_goback' : (raising option with_loc , 'a) fold = default + method fold_goto' : (qualname with_loc , 'a) fold = default + method fold_goto_depending': (goto_depending_stmt with_loc , 'a) fold = default + method fold_if' : (if_stmt with_loc , 'a) fold = default + method fold_initialize' : (initialize_stmt with_loc , 'a) fold = default + method fold_initiate' : (name with_loc list with_loc , 'a) fold = default + method fold_inspect' : (inspect_stmt with_loc , 'a) fold = default + method fold_invoke' : (invoke_stmt with_loc , 'a) fold = default + method fold_move' : (move_stmt with_loc , 'a) fold = default + method fold_multiply' : (multiply_stmt with_loc , 'a) fold = default + method fold_open' : (open_stmt with_loc , 'a) fold = default + method fold_perform' : (perform_stmt with_loc , 'a) fold = default + method fold_raise' : (raise_operand with_loc , 'a) fold = default + method fold_read' : (read_stmt with_loc , 'a) fold = default + method fold_release' : (release_stmt with_loc , 'a) fold = default + method fold_resume' : (qualname with_loc , 'a) fold = default + method fold_return' : (return_stmt with_loc , 'a) fold = default + method fold_rewrite' : (rewrite_stmt with_loc , 'a) fold = default + method fold_search' : (search_stmt with_loc , 'a) fold = default + method fold_set' : (set_stmt with_loc , 'a) fold = default + method fold_start' : (start_stmt with_loc , 'a) fold = default + method fold_stop' : (stop_stmt with_loc , 'a) fold = default + method fold_string_stmt' : (string_stmt with_loc , 'a) fold = default + method fold_subtract' : (basic_arithmetic_stmt with_loc, 'a) fold = default + method fold_terminate' : (terminate_stmt with_loc , 'a) fold = default + method fold_transform' : (transform_stmt with_loc , 'a) fold = default + method fold_unlock' : (unlock_stmt with_loc , 'a) fold = default + method fold_unstring' : (unstring_stmt with_loc , 'a) fold = default + method fold_validate' : (ident list with_loc , 'a) fold = default + method fold_write' : (write_stmt with_loc , 'a) fold = default + end + + let todo x = todo __MODULE__ x + and partial x = partial __MODULE__ x + + + let fold_varying_phrase (v: _ #folder) = + handle v#fold_varying_phrase + ~continue:begin fun { varying_ident; varying_from; + varying_by; varying_until } x -> x + >> fold_ident v varying_ident + >> fold_ident_or_numlit v varying_from + >> fold_option ~fold:fold_ident_or_numlit v varying_by + >> fold_condition v varying_until + end + + let fold_varying_phrase' (v: _ #folder) = + handle' v#fold_varying_phrase' ~fold:fold_varying_phrase v + + let fold_perform_mode (v: _ #folder) = + handle v#fold_perform_mode + ~continue:begin fun m x -> match m with + | PerformNTimes i -> x + >> fold_ident_or_intlit v i + | PerformUntil { with_test; until } -> x + >> fold_option ~fold:fold_stage v with_test + >> fold_condition v until + | PerformVarying { with_test; varying; after } -> x + >> fold_option ~fold:fold_stage v with_test + >> fold_varying_phrase' v varying + >> fold_list ~fold:fold_varying_phrase' v after + end + + let fold_allocate_kind (v: _ #folder) = + handle v#fold_allocate_kind + ~continue:begin function + | AllocateCharacters e -> fold_expression v e + | AllocateDataItem n -> fold_name' v n + end + + let fold_alter_operands' (v: _ #folder) = + handle' v#fold_alter_operands' v + ~fold:begin fun v { alter_source; alter_target } x -> x + >> fold_qualname v alter_source + >> fold_qualname v alter_target + end + + let fold_call_proto (v: _ #folder) = + handle v#fold_call_proto + ~continue:begin function + | CallProtoIdent i -> fold_ident v i + | CallProtoNested -> Fun.id + end + + let fold_call_prefix (v: _ #folder) = + handle v#fold_call_prefix + ~continue:begin fun p x -> match p with + | CallGeneral i -> x + >> fold_ident_or_strlit v i + | CallProto { called; prototype } -> x + >> fold_option ~fold:fold_ident_or_strlit v called + >> fold_call_proto v prototype + end + + let fold_close_format (v: _ #folder) = + handle v#fold_close_format + ~continue:begin function + | CloseUnitReel b -> fold_bool v b + | CloseWithLock + | CloseWithNoRewind -> Fun.id + end + + let fold_close_phrase (v: _ #folder) = + handle v#fold_close_phrase + ~continue:begin fun { close_item; close_format} x -> x + >> fold_name' v close_item + >> fold_option ~fold:fold_close_format v close_format + end + + let fold_init_data_category (v: _ #folder) = + leaf v#fold_init_data_category + + let fold_init_category (v: _ #folder) = function + | InitAll -> Fun.id + | InitCategory c -> fold_init_data_category v c + + let fold_init_replacing (v: _ #folder) = + handle v#fold_init_replacing + ~continue:begin fun { init_replacing_category; + init_replacing_replacement_item } x -> x + >> fold_init_data_category v init_replacing_category + >> fold_ident_or_literal v init_replacing_replacement_item + end + + let fold_inspect_where (v: _ #folder) = + handle v#fold_inspect_where + ~continue:begin fun (_, reference) -> + fold_ident_or_nonnum v reference + end + + let fold_tallying_spec (v: _ #folder) = + handle v#fold_tallying_spec + ~continue:begin fun { tallying_item; tallying_where } x -> x + >> fold_ident_or_nonnum v tallying_item + >> fold_list ~fold:fold_inspect_where v tallying_where + end + + let fold_tallying_clause' (v: _ #folder) = + handle' v#fold_tallying_clause' v + ~fold:begin fun v clause x -> match clause with + | TallyingCharacters wheres -> x + >> fold_list ~fold:fold_inspect_where v wheres + | TallyingRange (_, spec) -> x + >> fold_list ~fold:fold_tallying_spec v spec + end + + let fold_tallying (v: _ #folder) = + handle v#fold_tallying + ~continue:begin fun { tallying_target; tallying_clauses } x -> x + >> fold_qualident v tallying_target + >> fold_list ~fold:fold_tallying_clause' v tallying_clauses + end + + let fold_replacing_range_spec (v: _ #folder) = + handle v#fold_replacing_range_spec + ~continue:begin fun { replacing_item; + replacing_by; + replacing_where} x -> x + >> fold_ident_or_nonnum v replacing_item + >> fold_ident_or_nonnum v replacing_by + >> fold_list ~fold:fold_inspect_where v replacing_where + end + + let fold_replacing_clause (v: _ #folder) = + handle v#fold_replacing_clause + ~continue:begin fun clause x -> match clause with + | ReplacingCharacters { replacement; where } -> x + >> fold_ident_or_nonnum v replacement + >> fold_list ~fold:fold_inspect_where v where + | ReplacingRange (_, specs) -> x + >> fold_list ~fold:fold_replacing_range_spec v specs + end + + let fold_replacing (v:_ #folder) = + handle' v#fold_replacing v ~fold:fold_replacing_clause + + let fold_converting (v: _ #folder) = + handle v#fold_converting + ~continue:begin fun { converting_from; + converting_to; + converting_where} x -> x + >> fold_ident_or_nonnum v converting_from + >> fold_ident_or_nonnum v converting_to + >> fold_list ~fold:fold_inspect_where v converting_where + end + + let fold_inspect_spec (v: _ #folder) = + handle v#fold_inspect_spec + ~continue:begin fun spec x -> match spec with + | InspectTallying tl -> x + >> fold_list ~fold:fold_tallying v tl + | InspectReplacing rl -> x + >> fold_list ~fold:fold_replacing v rl + | InspectBoth (tl, rl) -> x + >> fold_list ~fold:fold_tallying v tl + >> fold_list ~fold:fold_replacing v rl + | InspectConverting converting -> x + >> fold_converting v converting + end + + let fold_merge_or_sort_target (v : _ #folder) = + handle v#fold_merge_or_sort_target + ~continue:begin function + | OutputProcedure name_procedure_range -> + fold_procedure_range ~fold:fold_name' v name_procedure_range + | Giving names -> + fold_list ~fold:fold_name' v names + end + + (*for open*) + let fold_named_file_option (v: _ #folder) = + handle v#fold_named_file_option + ~continue:begin fun { named_file_name; + named_file_option} x -> x + >> fold_name' v named_file_name + >> fold_option ~fold:fold_file_option v named_file_option + end + + let fold_open_phrase (v: _ #folder) = + handle v#fold_open_phrase + ~continue:begin fun { open_mode; open_sharing; + open_retry; open_files } x -> x + >> fold_open_mode v open_mode + >> fold_option ~fold:fold_sharing_mode v open_sharing + >> fold_option ~fold:fold_retry_clause v open_retry + >> fold_list ~fold:fold_named_file_option v open_files + end + + let fold_read_error (v: _ #folder) = + leaf v#fold_read_error + + let fold_set_switch_spec (v: _ #folder) = + handle v#fold_set_switch_spec + ~continue:begin fun { set_switch_targets; + set_switch_value } x -> x + >> fold_list ~fold:fold_ident v set_switch_targets + >> fold_on_off v set_switch_value + end + + let fold_set_condition_spec (v: _ #folder) = + handle v#fold_set_condition_spec + ~continue:begin fun { set_condition_targets; + set_condition_value } x -> x + >> fold_list ~fold:fold_ident v set_condition_targets + >> fold_bool v set_condition_value + end + + let fold_stop_kind (v: _ #folder) = + leaf v#fold_stop_kind + + let fold_stop_run (v: _ #folder) = + handle v#fold_stop_run + ~continue:begin fun { stop_kind; stop_status } x -> x + >> fold_stop_kind v stop_kind + >> fold_ident_or_literal v stop_status + end + + let fold_string_delimiter (v: _ #folder) = + handle v#fold_string_delimiter + ~continue:begin function + | StringDelimiter ident_or_nonnum -> + fold_ident_or_nonnum v ident_or_nonnum + | StringDelimiterSize -> Fun.id + end + + let fold_string_source (v: _ #folder) = + handle v#fold_string_source + ~continue:begin fun {string_source; string_delimiter} x -> x + >> fold_ident_or_nonnum v string_source + >> fold_option ~fold:fold_string_delimiter v string_delimiter + end + + let fold_unstring_delimiter (v: _ #folder) = + handle v#fold_unstring_delimiter + ~continue:begin fun { unstring_delimiter; + unstring_delimiter_by_all } x -> x + >> fold_ident_or_strlit v unstring_delimiter + >> fold_bool v unstring_delimiter_by_all + end + + let fold_unstring_target (v: _ #folder) = + handle v#fold_unstring_target + ~continue:begin fun { unstring_target; + unstring_target_delimiter; + unstring_target_count} x -> x + >> fold_ident v unstring_target + >> fold_option ~fold:fold_ident v unstring_target_delimiter + >> fold_option ~fold:fold_ident v unstring_target_count + end + + let fold_write_error (v: _ #folder) = + leaf v#fold_write_error + + + (* Statements that do not need recursion (not high-level control structure, + and no inline handler) *) + + let fold_allocate' (v: _ #folder) = + handle' v#fold_allocate' v + ~fold:begin fun v { allocate_kind; + allocate_initialized; + allocate_returning } x -> x + >> fold_allocate_kind v allocate_kind + >> fold_bool v allocate_initialized + >> fold_ident'_opt v allocate_returning + end + + let fold_alter' (v: _ #folder) = + handle' v#fold_alter' v ~fold:(fold_list ~fold:fold_alter_operands') + + let fold_cancel' (v: _ #folder) = + handle' v#fold_cancel' v ~fold:(fold_list ~fold:fold_ident_or_strlit) + + let fold_close' (v: _ #folder) = + handle' v#fold_close' v ~fold:(fold_list ~fold:fold_close_phrase) + + let fold_exit' (v: _ #folder) = + handle' v#fold_exit' v + ~fold:begin fun v -> function + | ExitSimple + | ExitParagraph + | ExitSection -> Fun.id + | ExitPerform b -> fold_bool v b + | ExitProgram r + | ExitMethod r + | ExitFunction r -> fold_option ~fold:fold_raising v r + end + + let fold_free' (v: _ #folder) = + handle' v#fold_free' v ~fold:(fold_list ~fold:fold_name') + + let fold_generate' (v: _ #folder) = + handle' v#fold_generate' v ~fold:fold_name' + + let fold_goback' (v: _ #folder) = + handle' v#fold_goback' v ~fold:(fold_option ~fold:fold_raising) + + let fold_goto' (v: _ #folder) = + handle' v#fold_goto' ~fold:fold_qualname v + + let fold_goto_depending' (v: _ #folder) = + handle' v#fold_goto_depending' v + ~fold:begin fun v { goto_depending_targets; goto_depending_on } x -> x + >> fold_list ~fold:fold_qualname v goto_depending_targets + >> fold_ident v goto_depending_on + end + + let fold_initialize' (v: _ #folder) = + handle' v#fold_initialize' v + ~fold:begin fun v { init_items; init_filler; init_category; + init_replacings; init_to_default } x -> x + >> fold_list ~fold:fold_ident v init_items + >> fold_bool v init_filler + >> fold_option ~fold:fold_init_category v init_category + >> fold_list ~fold:fold_init_replacing v init_replacings + >> fold_bool v init_to_default + end + + let fold_initiate' (v: _ #folder) = + handle' v#fold_initiate' v ~fold:(fold_list ~fold:fold_name') + + let fold_inspect' (v: _ #folder) = + handle' v#fold_inspect' v + ~fold:begin fun v { inspect_item; inspect_spec } x -> x + >> fold_ident v inspect_item + >> fold_inspect_spec v inspect_spec + end + + let fold_invoke' (v: _ #folder) = + handle' v#fold_invoke' v + ~fold:begin fun v { invoke_target; invoke_method; + invoke_using; invoke_returning} x -> x + >> fold_ident v invoke_target + >> fold_ident_or_strlit v invoke_method + >> fold_list ~fold:fold_call_using_clause' v invoke_using + >> fold_ident'_opt v invoke_returning + end + + let fold_move' (v: _ #folder) = + handle' v#fold_move' v + ~fold:begin fun v m x -> match m with + | MoveSimple { from; to_ } -> x + >> fold_ident_or_literal v from + >> fold_list ~fold:fold_ident v to_ + | MoveCorresponding { from; to_ } -> x + >> fold_ident v from + >> fold_list ~fold:fold_ident v to_ + end + + let fold_open' (v: _ #folder) = + handle' v#fold_open' v ~fold:(fold_list ~fold:fold_open_phrase) + + let fold_raise' (v: _ #folder) = + handle' v#fold_raise' v + ~fold:begin fun v -> function + | RaiseIdent id -> fold_ident v id + | RaiseException name -> fold_name' v name + end + + let fold_release' (v: _ #folder) = + handle' v#fold_release' v + ~fold:begin fun v {release_item; release_from} x -> x + >> fold_name' v release_item + >> fold_option ~fold:fold_ident_or_literal v release_from + end + + let fold_resume' (v: _ #folder) = + handle' v#fold_resume' v ~fold:(fold_qualname) + + let fold_set' (v: _ #folder) = + handle' v#fold_set' v + ~fold:begin fun v stmt x -> match stmt with + | SetAmbiguous { targets; set_method; value} -> x + >> fold_list ~fold:fold_ident v targets + >> fold_set_ambiguous_method v set_method + >> fold_expression v value + | SetSwitch specs -> x + >> fold_list ~fold:fold_set_switch_spec v specs + | SetCondition specs -> x + >> fold_list ~fold:fold_set_condition_spec v specs + | SetAttribute { name; attribute_switches } -> x + >> fold_name' v name + >> fold_list ~fold:fold_set_attribute_switch v attribute_switches + | SetSaveLocale { target; locale } -> x + >> fold_ident v target + >> fold_set_save_locale v locale + | SetLocale { target; source } -> x + >> fold_set_locale_target v target + >> fold_set_locale_source v source + | SetSavedException -> x + | SetFloatContent { targets; content; sign } -> x + >> fold_list ~fold:fold_ident v targets + >> fold_float_content v content + >> fold_option ~fold:fold_sign v sign + end + + let fold_terminate' (v: _ #folder) = + handle' v#fold_terminate' v + ~fold:(fold_list ~fold:fold_name') + + let fold_transform' (v: _ #folder) = + handle' v#fold_transform' v + ~fold:begin fun v { transform_ident; transform_from; transform_to } x -> x + >> fold_ident' v transform_ident + >> fold' ~fold:fold_ident_or_nonnum v transform_from + >> fold' ~fold:fold_ident_or_nonnum v transform_to + end + + let fold_unlock' (v: _ #folder) = + handle' v#fold_unlock' v + ~fold:begin fun v { unlock_file; unlock_record } x -> x + >> fold_name' v unlock_file + >> fold_bool v unlock_record + end + + let fold_validate' (v: _ #folder) = + handle' v#fold_validate' v ~fold:(fold_list ~fold:fold_ident) + + let fold_stop' (v: _ #folder) = + handle' v#fold_stop' v + ~fold:begin fun v -> function + | StopRun o -> fold_option ~fold:fold_stop_run v o + | StopLiteral l -> fold_literal v l + end + + let fold_selection_subject (v: _ #folder) = + handle v#fold_selection_subject + ~continue:begin function + | Subject c -> fold_condition v c + | SubjectConst b -> fold_bool v b + end + + let fold_selection_object (v: _ #folder) = + handle v#fold_selection_object + ~continue:begin fun selection_object x -> + match selection_object with + | SelCond c -> x + >> fold_condition v c + | SelRange { negated; start; stop; alphabet} -> x + >> fold_bool v negated + >> fold_expression v start + >> fold_expression v stop + >> fold_option ~fold:fold_name' v alphabet + | SelRelation { relation; expr } -> x + >> fold_relop v relation + >> fold_expression v expr + | SelClassCond { negated; class_specifier } -> x + >> fold_bool v negated + >> fold_class v class_specifier + | SelSignCond { negated; sign_specifier } -> x + >> fold_bool v negated + >> fold_signz v sign_specifier + | SelOmitted { negated } -> x + >> fold_bool v negated + | SelConst b -> x + >> fold_bool v b + | SelAny -> x + end + + (* Statements with high-level control structure and/or (inline) handlers *) + let rec fold_statement' (v: _ #folder) = + handle v#fold_statement' + ~continue:begin fun { payload; loc } -> match payload with + | Accept s -> fold_accept' v (s &@ loc) + | Allocate s -> fold_allocate' v (s &@ loc) + | Add s -> fold_add' v (s &@ loc) + | Alter s -> fold_alter' v (s &@ loc) + | Call s -> fold_call' v (s &@ loc) + | Cancel s -> fold_cancel' v (s &@ loc) + | Close s -> fold_close' v (s &@ loc) + | Compute s -> fold_compute' v (s &@ loc) + | Delete s -> fold_delete' v (s &@ loc) + | Display s -> fold_display' v (s &@ loc) + | Divide s -> fold_divide' v (s &@ loc) + | Evaluate s -> fold_evaluate' v (s &@ loc) + | Exit s -> fold_exit' v (s &@ loc) + | Free s -> fold_free' v (s &@ loc) + | Generate s -> fold_generate' v (s &@ loc) + | GoBack s -> fold_goback' v (s &@ loc) + | GoTo s -> fold_goto' v (s &@ loc) + | GoToDepending s -> fold_goto_depending' v (s &@ loc) + | If s -> fold_if' v (s &@ loc) + | Initialize s -> fold_initialize' v (s &@ loc) + | Initiate s -> fold_initiate' v (s &@ loc) + | Inspect s -> fold_inspect' v (s &@ loc) + | Invoke s -> fold_invoke' v (s &@ loc) + | Move s -> fold_move' v (s &@ loc) + | Multiply s -> fold_multiply' v (s &@ loc) + | Open s -> fold_open' v (s &@ loc) + | Perform s -> fold_perform' v (s &@ loc) + | Raise s -> fold_raise' v (s &@ loc) + | Read s -> fold_read' v (s &@ loc) + | Release s -> fold_release' v (s &@ loc) + | Resume s -> fold_resume' v (s &@ loc) + | Return s -> fold_return' v (s &@ loc) + | Rewrite s -> fold_rewrite' v (s &@ loc) + | Search s -> fold_search' v (s &@ loc) + | Set s -> fold_set' v (s &@ loc) + | Start s -> fold_start' v (s &@ loc) + | Stop s -> fold_stop' v (s &@ loc) + | String s -> fold_string_stmt' v (s &@ loc) + | Subtract s -> fold_subtract' v (s &@ loc) + | Terminate s -> fold_terminate' v (s &@ loc) + | Transform s -> fold_transform' v (s &@ loc) + | Unlock s -> fold_unlock' v (s &@ loc) + | Unstring s -> fold_unstring' v (s &@ loc) + | Validate s -> fold_validate' v (s &@ loc) + | Write s -> fold_write' v (s &@ loc) + | ResumeNextStatement + | Continue + | LoneGoTo + | Suppress -> Fun.id + | _ -> partial __LINE__ "fold_statement" + (* | Disable of mcs_command_operands *) + (* | Enable of mcs_command_operands *) + (* | Enter of enter_stmt *) + (* | Merge of merge_stmt *) + (* | Purge of name with_loc *) + (* | Receive of receive_stmt *) + (* | Send of send_stmt *) + (* | Sort of sort_stmt *) + end + + and fold_statements (v: _ #folder) = + (* handle v#fold_statements ~continue: *)(fold_list ~fold:fold_statement' v) + + and fold_statements' (v: _ #folder) = + handle' v#fold_statements' ~fold:fold_statements v + + and fold_handler v = fold_statements v + and fold_dual_handler (v: _ #folder) { dual_handler_pos; + dual_handler_neg } x = x + >> fold_handler v dual_handler_pos + >> fold_handler v dual_handler_neg + + and fold_branch (v: _ #folder) : branch -> 'a -> 'a = function + | Statements stmts -> fold_statements v stmts + | NextSentence -> Fun.id + + and fold_basic_arith_stmt (v: _ #folder) : basic_arithmetic_stmt -> 'a -> 'a = + fun { basic_arith_operands; basic_arith_on_size_error } x -> x + >> fold_basic_arithmetic_operands v basic_arith_operands + >> fold_dual_handler v basic_arith_on_size_error + + and fold_accept' (v: _ #folder) : accept_stmt with_loc -> 'a -> 'a = + handle' v#fold_accept' v + ~fold:begin fun v stmt x -> match stmt with + | AcceptGeneric id -> x + >> fold_ident' v id + | AcceptFromDevice { item; device_item } -> x + >> fold_ident' v item + >> fold_name' v device_item + | AcceptTemporal { item; date_time } -> x + >> fold_ident' v item + >> fold_date_time v date_time + | AcceptMsgCount name' -> x + >> fold_name' v name' + | AcceptAtScreen { item; position; on_exception } -> x + >> fold_name' v item + >> fold_option ~fold:fold_position v position + >> fold_dual_handler v on_exception + | AcceptFromEnv { item; env_item; on_exception } -> x + >> fold_ident' v item + >> fold' ~fold:fold_ident_or_nonnum v env_item + >> fold_dual_handler v on_exception + end + + and fold_add' (v: _ #folder) : basic_arithmetic_stmt with_loc -> 'a -> 'a = + handle' v#fold_add' v ~fold:fold_basic_arith_stmt + + and fold_call' (v: _ #folder) : call_stmt with_loc -> 'a -> 'a = + handle' v#fold_call' v + ~fold:begin fun v { call_prefix; call_using; call_returning; + call_error_handler } x -> x + >> fold_call_prefix v call_prefix + >> fold_list ~fold:fold_call_using_clause' v call_using + >> fold_ident'_opt v call_returning + >> fold_option ~fold:fold_call_error_handler v call_error_handler + end + + and fold_call_error_handler (v: _ #folder) = + handle v#fold_call_error_handler + ~continue:begin function + | CallOnOverflow h -> fold_handler v h + | CallOnException h -> fold_dual_handler v h + end + + and fold_compute' (v: _ #folder) : compute_stmt with_loc -> 'a -> 'a = + handle' v#fold_compute' v + ~fold:begin fun v { compute_targets; compute_expr; + compute_on_size_error } x -> x + >> fold_rounded_idents v compute_targets + >> fold_expr v compute_expr + >> fold_dual_handler v compute_on_size_error + end + + and fold_delete' (v: _ #folder) : delete_stmt with_loc -> 'a -> 'a = + handle' v#fold_delete' v + ~fold:begin fun v { delete_targets; delete_retry; + delete_on_invalid_key } x -> x + >> fold_name' v delete_targets + >> fold_option ~fold:fold_retry_clause v delete_retry + >> fold_dual_handler v delete_on_invalid_key + end + + and fold_display' (v: _ #folder) : display_stmt with_loc -> 'a -> 'a = + handle' v#fold_display' v + ~fold:begin fun v d x -> match d with + | DisplayDefault i -> x + >> fold_ident_or_literal v i + | DisplayDevice { displayed_items; upon; advancing } -> x + >> fold_list ~fold:fold_ident_or_literal v displayed_items + >> fold_option ~fold:fold_display_target' v upon + >> fold_bool v advancing + | DisplayScreen { screen_item; position; on_exception } -> x + >> fold_name' v screen_item + >> fold_option ~fold:fold_position v position + >> fold_dual_handler v on_exception + end + + and fold_display_target' (v: _ #folder) : display_target with_loc -> 'a -> 'a = + (* handle' v#fold_display_target' *)fold' v + ~fold:begin fun v -> function + | DisplayUponName n -> fold_name' v n + | DisplayUponDeviceViaMnemonic _ -> Fun.id + end + + and fold_divide' (v: _ #folder) : divide_stmt with_loc -> 'a -> 'a = + handle' v#fold_divide' v + ~fold:begin fun v { divide_operands; divide_on_size_error } x -> x + >> fold_divide_operands v divide_operands + >> fold_dual_handler v divide_on_size_error + end + + and fold_evaluate' (v: _ #folder) : evaluate_stmt with_loc -> 'a -> 'a = + handle' v#fold_evaluate' v + ~fold:begin fun v { eval_subjects; eval_branches; eval_otherwise } x -> x + >> fold_list ~fold:fold_selection_subject v eval_subjects + >> fold_list ~fold:fold_evaluate_branch v eval_branches + >> fold_statements v eval_otherwise + end + + and fold_evaluate_branch (v: _#folder) = + handle v#fold_evaluate_branch + ~continue:begin fun { eval_selection; eval_actions } x -> x + >> fold_list v eval_selection + ~fold:(fold_list ~fold:fold_selection_object) + >> fold_statements v eval_actions + end + + and fold_if' (v: _ #folder) : if_stmt with_loc -> 'a -> 'a = + handle' v#fold_if' v + ~fold:begin fun v { condition; then_branch; else_branch } x -> x + >> fold_condition v condition + >> fold_branch v then_branch + >> fold_option ~fold:fold_branch v else_branch + end + + and fold_multiply' (v: _ #folder) : multiply_stmt with_loc -> 'a -> 'a = + handle' v#fold_multiply' v + ~fold:begin fun v { multiply_operands; multiply_on_size_error } x -> x + >> fold_multiply_operands v multiply_operands + >> fold_dual_handler v multiply_on_size_error + end + + and fold_perform' (v: _ #folder) : perform_stmt with_loc -> 'a -> 'a = + handle' v#fold_perform' v + ~fold:begin fun v { perform_target; perform_mode } x -> x + >> fold_perform_target v perform_target + >> fold_option ~fold:fold_perform_mode v perform_mode + end + + and fold_perform_target (v: _ #folder) = + handle v#fold_perform_target + ~continue:begin function + | PerformOutOfLine proc_range -> + fold_procedure_range ~fold:fold_qualname v proc_range + | PerformInline stmts -> + fold_statements v stmts + end + + and fold_read_error_handler (v: _ #folder) = + handle v#fold_read_error_handler + ~continue:begin fun (read_error, dual_handler) x -> x + >> fold_read_error v read_error + >> fold_dual_handler v dual_handler + end + + and fold_read' (v: _#folder) = + handle' v#fold_read' v + ~fold:begin fun v { read_file; read_direction; + read_into; read_lock_behavior; + read_lock; read_key; + read_error_handler } x -> x + >> fold_name' v read_file + >> fold_option ~fold:fold_read_direction v read_direction + >> fold_option ~fold:fold_ident v read_into + >> fold_option ~fold:fold_read_lock_behavior v read_lock_behavior + >> fold_option ~fold:fold_bool v read_lock + >> fold_option ~fold:fold_qualname v read_key + >> fold_option ~fold:fold_read_error_handler v read_error_handler + end + + and fold_return' (v: _ #folder) = + handle' v#fold_return' v + ~fold:begin fun v {return_file; return_into; return_at_end} x -> x + >> fold_name' v return_file + >> fold_ident'_opt v return_into + >> fold_dual_handler v return_at_end + end + + and fold_rewrite' (v: _ #folder) = + handle' v#fold_rewrite' v + ~fold:begin fun v { rewrite_to; rewrite_from; + rewrite_retry; rewrite_lock; + rewrite_invalid_key_handler } x -> x + >> fold_write_target v rewrite_to + >> fold_option ~fold:fold_ident_or_literal v rewrite_from + >> fold_option ~fold:fold_retry_clause v rewrite_retry + >> fold_option ~fold:fold_bool v rewrite_lock + >> fold_dual_handler v rewrite_invalid_key_handler + end + + and fold_search_when_clause' (v: _#folder) = + handle' v#fold_search_when_clause' v + ~fold:begin fun v {search_when_cond; search_when_stmts} x -> x + >> fold_condition v search_when_cond + >> fold_branch v search_when_stmts + end + + and fold_search_spec (v: _ #folder) = + handle v#fold_search_spec + ~continue:begin fun s x -> match s with + | SearchSerial { varying; when_clauses } -> x + >> fold_option ~fold:fold_ident v varying + >> fold_list ~fold:fold_search_when_clause' v when_clauses + | SearchAll { conditions; action } -> x + >> fold_list ~fold:fold_search_condition v conditions + >> fold_branch v action + end + + and fold_search' (v: _ #folder) = + handle' v#fold_search' v + ~fold:begin fun v { search_item; search_spec; + search_at_end} x -> x + >> fold_qualname v search_item + >> fold_handler v search_at_end + >> fold_search_spec v search_spec + end + + and fold_start' (v: _ #folder) = + handle' v#fold_start' v + ~fold:begin fun v { start_file; start_position; + start_on_invalid_key } x -> x + >> fold_name' v start_file + >> fold_option ~fold:fold_start_position v start_position + >> fold_dual_handler v start_on_invalid_key + end + + and fold_string_stmt' (v: _ #folder) = + handle' v#fold_string_stmt' v + ~fold:begin fun v { string_sources; + string_target; + string_pointer; + string_on_overflow} x -> x + >> fold_list ~fold:fold_string_source v string_sources + >> fold_ident v string_target + >> fold_option ~fold:fold_ident v string_pointer + >> fold_dual_handler v string_on_overflow + end + + and fold_subtract' (v: _ #folder) : basic_arithmetic_stmt with_loc -> 'a -> 'a = + handle' v#fold_subtract' v ~fold:fold_basic_arith_stmt + + and fold_unstring' (v: _ #folder) = + handle' v#fold_unstring' v + ~fold:begin fun v { unstring_source; + unstring_delimiters; + unstring_targets; + unstring_pointer; + unstring_tallying; + unstring_on_overflow} x -> x + >> fold_ident v unstring_source + >> fold_list ~fold:fold_unstring_delimiter v unstring_delimiters + >> fold_list ~fold:fold_unstring_target v unstring_targets + >> fold_option ~fold:fold_ident v unstring_pointer + >> fold_option ~fold:fold_ident v unstring_tallying + >> fold_dual_handler v unstring_on_overflow + end + + and fold_write_error_handler (v: _ #folder) = + handle v#fold_write_error_handler + ~continue:begin fun (write_error, dual_handler) x -> x + >> fold_write_error v write_error + >> fold_dual_handler v dual_handler + end + + and fold_write' (v: _ #folder) = + handle' v#fold_write' v + ~fold:begin fun v { write_to; write_from; + write_advancing; write_retry; + write_lock; write_error_handler } x -> x + >> fold_write_target v write_to + >> fold_option ~fold:fold_ident_or_literal v write_from + >> fold_option ~fold:fold_advancing_phrase v write_advancing + >> fold_option ~fold:fold_retry_clause v write_retry + >> fold_option ~fold:fold_bool v write_lock + >> fold_option ~fold:fold_write_error_handler v write_error_handler + end + +end diff --git a/src/lsp/cobol_ast/raw_visitor.ml b/src/lsp/cobol_ast/raw_visitor.ml new file mode 100644 index 000000000..8e088f1ba --- /dev/null +++ b/src/lsp/cobol_ast/raw_visitor.ml @@ -0,0 +1,19 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Make_for_misc_sections = Raw_misc_sections_visitor.Make +module Make_for_data_sections = Raw_data_sections_visitor.Make +module Make_for_data_division = Raw_data_division_visitor.Make +module Make_for_statements = Raw_statements_visitor.Make +module Make_for_proc_division = Raw_proc_division_visitor.Make +module Make_for_compilation_group = Raw_compilation_group_visitor.Make diff --git a/src/lsp/cobol_ast/simple_statements.ml b/src/lsp/cobol_ast/simple_statements.ml new file mode 100644 index 000000000..f465d2570 --- /dev/null +++ b/src/lsp/cobol_ast/simple_statements.ml @@ -0,0 +1,453 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Non-branching statements *) + +open Terms +open Operands + + +(* +ALLOCATE exp CHARACTERS INIT? (RET id)? +ALLOCATE id INIT? (RET id)? +*) + +(* ALLOCATE *) +type allocate_stmt = + { + allocate_kind: allocate_kind; + allocate_initialized: bool; + allocate_returning: ident with_loc option; + } +[@@deriving show, ord] + +and allocate_kind = + | AllocateCharacters of expression (*arith exp that evaluates to int (may be rounded)*) + | AllocateDataItem of name with_loc +[@@deriving show, ord] + + +(* +ALTER id TO PROCEED? id +*) + +(* ALTER *) +type alter_stmt = + alter_operands with_loc list +[@@deriving show, ord] + +and alter_operands = + { + alter_source: qualname; + alter_target: qualname; + } +[@@deriving show, ord] + + +(* CLOSE *) +type close_stmt = close_phrase list [@@deriving show, ord] +and close_phrase = + { + close_item: name with_loc; + close_format: close_format option; + } +[@@deriving show, ord] + +and close_format = + | CloseUnitReel of bool (* for removal *) + | CloseWithLock + | CloseWithNoRewind +[@@deriving show, ord] + + +(* ENTER *) +type enter_stmt = + { + enter_language: name with_loc; + enter_routine: name with_loc option; + } +[@@deriving show, ord] + + +(* EXIT *) +type exit_stmt = + | ExitSimple + | ExitProgram of raising option + | ExitMethod of raising option + | ExitFunction of raising option + | ExitPerform of bool + | ExitParagraph + | ExitSection +[@@deriving show, ord] + + +(* INITIALIZE *) +type initialize_stmt = + { + init_items: ident list; + init_filler: bool; + init_category: init_category option; + init_replacings: init_replacing list; + init_to_default: bool; + } +[@@deriving show, ord] + +and init_category = + | InitAll + | InitCategory of init_data_category +[@@deriving show, ord] + +and init_replacing = + { + init_replacing_category: init_data_category; + init_replacing_replacement_item: ident_or_literal; + } +[@@deriving show, ord] + +and init_data_category = + | InitCategoryAlphabetic + | InitCategoryAlphanumeric + | InitCategoryAlphanumericEdited + | InitCategoryBoolean + | InitCategoryDataPointer + | InitCategoryFunctionPointer + | InitCategoryNational + | InitCategoryNationalEdited + | InitCategoryNumeric + | InitCategoryNumericEdited + | InitCategoryObjectReference + | InitCategoryProgramPointer +[@@deriving show, ord] + + +(* INVOKE *) +type invoke_stmt = + { + invoke_target: ident; + invoke_method: ident_or_strlit; + invoke_using: call_using_clause with_loc list; + invoke_returning: ident with_loc option; + (* error_htypeler: error_htypeler; (* seen on IBM Cobol *) *) + } +[@@deriving show, ord] + + +(* INSPECT *) +type inspect_stmt = + { + inspect_item: ident; + inspect_spec: inspect_spec; + } +[@@deriving show, ord] + +and inspect_spec = + | InspectTallying of tallying list + | InspectReplacing of replacing list + | InspectBoth of tallying list * replacing list + | InspectConverting of converting +[@@deriving show, ord] + +and tallying = + { + tallying_target: qualident; + tallying_clauses: tallying_clause with_loc list; + } +[@@deriving show, ord] + +and tallying_clause = + | TallyingCharacters of inspect_where list + | TallyingRange of tallying_range * tallying_spec list +[@@deriving show, ord] + +and tallying_range = + | TallyAll + | TallyLeading +[@@deriving show, ord] + +and tallying_spec = + { + tallying_item: ident_or_nonnum; + tallying_where: inspect_where list; + } +[@@deriving show, ord] + +and replacing = replacing_clause with_loc +[@@deriving show ,ord] + +and replacing_clause = + | ReplacingCharacters of + { + replacement: ident_or_nonnum; + where: inspect_where list; + } + | ReplacingRange of replacing_range * replacing_range_spec list +[@@deriving show, ord] + +and replacing_range = + | ReplaceAll + | ReplaceLeading + | ReplaceFirst +[@@deriving show, ord] + +and replacing_range_spec = + { + replacing_item: ident_or_nonnum; + replacing_by: ident_or_nonnum; + replacing_where: inspect_where list; + } +[@@deriving show, ord] + +and converting = + { + converting_from: ident_or_nonnum; + converting_to: ident_or_nonnum; + converting_where: inspect_where list; + } +[@@deriving show, ord] + +and inspect_where = inspect_direction * inspect_reference +[@@deriving show, ord] + +and inspect_direction = + | InspectAfter + | InspectBefore +[@@deriving show, ord] + +and inspect_reference = ident_or_nonnum +[@@deriving show, ord] + + +(* MERGE *) +type merge_stmt = + { + merge_file: name with_loc; + merge_keys: Data_descr.sort_spec list; + merge_collating: Misc_descr.alphabet_specification option; + merge_using: name with_loc list; + merge_target: merge_or_sort_target; + } +[@@deriving show, ord] + +and merge_or_sort_target = + | OutputProcedure of name with_loc procedure_range + | Giving of name with_loc list +[@@deriving show, ord] + + +(* MOVE *) +type move_stmt = (* TODO: maybe split in two distinct statements *) + | MoveSimple of + { + from: ident_or_literal; + to_: ident list; + } + | MoveCorresponding of + { + from: ident; + to_: ident list; + } +[@@deriving show, ord] + + +(* OPEN *) +type open_stmt = open_phrase list [@@deriving show, ord] +and open_phrase = + { + open_mode: open_mode; + open_sharing: sharing_mode option; + open_retry: retry_clause option; + open_files: named_file_option list; + } +[@@deriving show, ord] + +and named_file_option = + { + named_file_name: name with_loc; + named_file_option: file_option option; + } +[@@deriving show, ord] + + +(* RELEASE *) +type release_stmt = + { + release_item: name with_loc; + release_from: ident_or_literal option; + } +[@@deriving show, ord] + + +(* SEND *) +type send_stmt = + { + send_name: name with_loc; + send_operands: send_operands; + } +[@@deriving show, ord] + +and send_operands = + | SendSimple of + { + from: ident; + } + | SendWith of + { + from: ident option; + ending_indicator: message_ending_indicator; + advancing: advancing_phrase option; + replace: bool; + } +[@@deriving show, ord] + +and message_ending_indicator = + | EndingIndicator of ident + | EndingIndicatorESI + | EndingIndicatorEMI + | EndingIndicatorEGI +[@@deriving show, ord] + + +(* SET *) + + (* + SET ADDR/id... UPBY/DOWNBY/TO id/exp/int + + SET (id... TO ON/OFF)... + SET (id... TO TRUE/FALSE)... + + SET id ATTRIBUTE + SET id TO LOCALE + + SET LOCALE + SET LAST EXCEPTION + SET CONTENT + *) +type set_stmt = + | SetAmbiguous of + { + targets: ident list; + set_method: set_ambiguous_method; + value: expression; + } + | SetSwitch of + set_switch_spec list + | SetCondition of + set_condition_spec list + | SetAttribute of + { + name: name with_loc; + attribute_switches: set_attribute_switch list; + } + | SetSaveLocale of + { + target: ident; + locale: set_save_locale; + } + | SetLocale of + { + target: set_locale_target; + source: set_locale_source; + } + | SetSavedException + | SetFloatContent of + { + targets: ident list; + content: float_content; + sign: sign option; + } +[@@deriving show, ord] + +and set_switch_spec = + { + set_switch_targets: ident list; + set_switch_value: on_off; + } +[@@deriving show, ord] + +and set_condition_spec = + { + set_condition_targets: ident list; + set_condition_value: bool; + } +[@@deriving show, ord] + + + +(* SORT *) +type sort_stmt = + | SortFile of + { + file: qualident; + keys: Data_descr.sort_spec list; (* Not empty *) + duplicate_in_order: bool; + collating: Misc_descr.alphabet_specification option; + source: sort_source; + target: merge_or_sort_target; + } + | SortTable of + { + table: qualident; + keys: Data_descr.sort_spec list; (* Can be empty *) + duplicate_in_order: bool; + collating: Misc_descr.alphabet_specification option; + } +[@@deriving show, ord] + +and sort_source = (* SORT only *) + | SortInputProcedure of name with_loc procedure_range + | SortUsing of name with_loc list +[@@deriving show, ord] + + +(* STOP *) +type stop_stmt = + | StopRun of stop_run option + | StopLiteral of literal +[@@deriving show, ord] + +and stop_run = + { + stop_kind: stop_kind; + stop_status: ident_or_literal; + } +[@@deriving show, ord] + +and stop_kind = + | StopRunError + | StopRunNormal +[@@deriving show, ord] + + +type terminate_stmt = + name with_loc list +[@@deriving show, ord] + + +(* TRANSFORM *) + +type transform_stmt = + { + transform_ident: ident with_loc; + transform_from: ident_or_nonnum with_loc; + transform_to: ident_or_nonnum with_loc; + } +[@@deriving show, ord] + + +(* UNLOCK *) +type unlock_stmt = + { + unlock_file: name with_loc; + unlock_record: bool; + } +[@@deriving show, ord] diff --git a/src/lsp/cobol_ast/terms.ml b/src/lsp/cobol_ast/terms.ml new file mode 100644 index 000000000..89e43c984 --- /dev/null +++ b/src/lsp/cobol_ast/terms.ml @@ -0,0 +1,849 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +include Numericals + +type lexloc = Cobol_common.Srcloc.lexloc +type srcloc = Cobol_common.Srcloc.srcloc + +type 'a with_loc = 'a Cobol_common.Srcloc.with_loc = + { payload: 'a; loc: srcloc [@compare fun _ _ -> 0]; } + [@@deriving ord] +let pp_with_loc = Cobol_common.Srcloc.pp_with_loc + +type name = string +[@@deriving ord] +let pp_name = Pretty.string + +let pp_name' ppf { payload; _ } = pp_name ppf payload + +(** {2 Term attributes} *) + +(* Polymorphic GADT parameter types are a neat solution to share type and tag + names. This is what we use to unify the type of all/most terms in the + syntax. + + For now this appears to break `deriving.show` (ppx), but that limitation + should not prevent us from using neat typing features and obtain ASTs that + are easier to work with. +*) +type alnum_ = [ `AlphaNum ] +type bool_ = [ `Bool ] +type fixed_ = [ `Fixed ] +type float_ = [ `Float ] +type ident_ = [ `Ident ] +type int_ = [ `Int ] +type name_ = [ `Name ] +type national_ = [ `National ] +type 'a qual_ = [ `Qual of 'a ] +type qualname_ = [name_|name qual_] +type num_ = [int_|fixed_|float_] +type nonnum_ = [alnum_|national_|bool_] +type strlit_ = [alnum_|national_] +type lit_ = [nonnum_|bool_|num_] + + +(* Attributes for distinguishing expressions *) +type simple_ = [ `Simple ] +type complex_ = [ `Complex ] + +(* Attributes for distinguishing sign conditions *) +type strict_ = [ `Strict ] +type loose_ = [ `Loose ] + +(** Now comes the type of all/most terms *) +type _ term = + | Alphanum: string -> [>alnum_] term + | Boolean: boolean -> [>bool_] term + | Fixed: fixed -> [>fixed_] term + | Floating: floating -> [>float_] term + | Integer: integer -> [>int_] term + | National: string -> [>national_] term + + | NumFig: int_ figurative -> [>int_] term + | Fig: [nonnum_|strlit_] figurative -> [>strlit_] term + + | Name: name with_loc -> [>name_] term + | Qual: name with_loc * qualname_ term -> [>name qual_] term + + | Address: address -> [>ident_] term + | Counter: counter -> [>ident_] term + | InlineCall: inline_call -> [>ident_] term + | InlineInvoke: inline_invocation -> [>ident_] term + | ObjectView: object_view -> [>ident_] term + | ObjectRef: object_ref -> [>ident_] term (* Includes predefined address (NULL) *) + | QualIdent: qualident -> [>ident_] term (* Includes subscripts and ref-mod *) + + | StrConcat: strlit_ term * strlit_ term -> [>strlit_] term + | Concat: nonnum_ term * nonnum_ term -> [>nonnum_] term + +and _ figurative = + | Zero: [strlit_] figurative (* ALPHA/NAT *) + | Quote: [>strlit_] figurative (* ALPHA/NAT *) + | LowValue: [>strlit_] figurative (* ALPHA/NAT *) + | HighValue: [>strlit_] figurative (* ALPHA/NAT *) + | All: nonnumlit -> [ [>simple_] cond (* exp (bool), ident (bool, cond, switch) *) + | Relation: expression * relop * expression -> [>simple_] cond (* general, bool, pointer *) + | ClassCond: expression * class_ -> [>simple_] cond (* exp = ident *) + | SignCond: expression * signz -> [>simple_] cond (* exp = arith exp *) + | Omitted: expression -> [>simple_] cond (* exp = ident *) + | Not: _ cond -> [>complex_] cond + | Logop: _ cond * logop * _ cond -> [>complex_] cond (* TODO: move logop left *) + +and condition = [simple_|complex_] cond +and simple_condition = simple_ cond + +and logop = + | LAnd + | LOr + +and relop = + | Gt + | Lt + | Eq + | Ne + | Ge + | Le + +and class_ = + | AlphabetOrClass of name with_loc + | Alphabetic + | AlphabeticLower + | AlphabeticUpper + | ClassBoolean + | FarthestFromZero + | FloatInfinity + | FloatNotANumber + | FloatNotANumberQuiet + | FloatNotANumberSignaling + | InArithmeticRange + | NearestToZero + | ClassNumeric + + +and inline_call = (* in ancient terms: funident *) + { + call_fun: name with_loc; + call_args: effective_arg list; + call_refmod: refmod option; + } + +and effective_arg = (* TODO: could be an [expression option] *) + | ArgExpr of expression (* Regroup identifiers, literals and arithmetic expressions *) + | ArgOmitted + +and qualident = + { + ident_name: qualname; + ident_subscripts: subscript list; + ident_refmod: refmod option; + } + +and subscript = + | SubSAll + | SubSExpr of expression + | SubSIdx of name with_loc * sign * integer + +and _ sign_cond = + | SgnPositive: [ int + (*manual compare for term*) + let compare_struct first lazy_cmp = + if first <> 0 + then first + else Lazy.force lazy_cmp + let compare_with_loc_name = + compare_with_loc compare_name + + let rec compare_term: type a. a term compare_fun = + fun x y -> match x , y with + | Alphanum a, Alphanum b -> + String.compare a b + | Alphanum _, Fig HighValue -> + -1 + | Alphanum _, Fig _ -> 1 + | Boolean a, Boolean b -> + Stdlib.compare a b + | Integer a, Integer b -> + String.compare a b + | Integer _, Fig Zero + | Integer _, NumFig Zero -> + 1 + | National a, National b -> + String.compare a b + | National _, Fig HighValue -> + -1 + | National _, Fig _ -> + 1 + | NumFig Zero, Integer _ -> + -1 + | NumFig Zero, NumFig Zero -> + 0 + | Fig Zero, Integer _ -> + -1 + | Fig _, Fig _ -> + 0 (* TODO: `compare_fig` *) + | Name a, Name b -> + compare_with_loc_name a b + | Qual (a, c), Qual (b, d) -> + let first = compare_with_loc_name a b in + if first <> 0 + then first + else compare_term c d + | Address a, Address b -> + compare_address a b + | Counter a, Counter b -> + compare_counter a b + | InlineCall a, InlineCall b -> + compare_inline_call a b + | InlineInvoke a, InlineInvoke b -> + compare_inline_invoke a b + | ObjectView a, ObjectView b -> + compare_object_view a b + | ObjectRef a, ObjectRef b -> + compare_object_ref a b + | QualIdent a, QualIdent b -> + compare_qualident a b + | StrConcat (a, c), StrConcat (b, d) -> + compare_struct (compare_term a b) @@ lazy (compare_term c d) + | Concat(a,c), Concat(b,d) -> + compare_struct (compare_term a b) @@ lazy (compare_term c d) + | a , b -> + Stdlib.compare a b + and compare_expression x y = match x, y with + | Atom a ,Atom b -> + compare_term a b + | Unop(a, c), Unop(b, d) -> + compare_struct (Stdlib.compare a b) @@ lazy (compare_expression c d) + | Binop(a, c ,e), Binop(b, d, f) -> + compare_struct (Stdlib.compare c d) @@ + lazy (compare_struct (compare_expression a b) @@ + lazy (compare_expression e f)) + (* take the arbitrari order Binop > Unop > Atom *) + | Atom _, _ -> + -1 + | _, Atom _-> + 1 + | Unop _, _ -> + -1 + | _, Unop _ -> + 1 + and compare_cond a b = match a, b with + | Expr x, Expr y -> + compare_expression x y + | Relation (x1, r1, y1), Relation (x2, r2, y2) -> + compare_struct (compare_expression x1 x2) @@ + lazy (compare_struct (compare r1 r2) @@ lazy (compare_expression y1 y2)) + | ClassCond (x1, c1), ClassCond (x2, c2) -> + compare_struct (compare_expression x1 x2) @@ lazy (compare_class_ c1 c2) + | SignCond (x1, s1), SignCond(x2, s2) -> + compare_struct (compare_expression x1 x2) @@ lazy (compare_signz s1 s2) + | a, b -> + Stdlib.compare a b + and compare_relop = + Stdlib.compare + and compare_class_ a b = match a, b with + | AlphabetOrClass n1, AlphabetOrClass n2 -> + compare_with_loc_name n1 n2 + | a, b -> + Stdlib.compare a b + and compare_qualident + { ident_name = a; ident_subscripts = c; ident_refmod = e } + { ident_name = b; ident_subscripts = d; ident_refmod = f } = + compare_struct (compare_term a b) @@ + lazy (compare_struct (List.compare compare_subcript c d) @@ + lazy (Option.compare compare_refmod e f)) + and compare_subcript x y = match x,y with + | SubSExpr a ,SubSExpr b -> + compare_expression a b + | SubSIdx(n1, s1, i1), + SubSIdx(n2, s2, i2) -> + compare_struct (compare_with_loc_name n1 n2) @@ + lazy (compare_struct (compare_sign s1 s2) @@ lazy (compare i1 i2)) + | a, b -> + Stdlib.compare a b + and compare_refmod + { leftmost = a; length_opt = c } + { leftmost = b; length_opt = d } = + compare_struct (compare_expression a b) @@ + lazy (Option.compare compare_expression c d) + and compare_sign : strict_ sign_cond compare_fun = compare + and compare_signz : loose_ sign_cond compare_fun = compare + and compare_object_ref x y = match x, y with + | Super a, Super b -> + Option.compare compare_with_loc_name a b + | a, b -> + Stdlib.compare a b + and compare_object_view + { object_view_ident = a; object_view_spec = c } + { object_view_ident = b; object_view_spec = d } = + compare_struct (compare_ident a b) @@ lazy (compare_object_view_spec c d) + and compare_object_view_spec x y = match x, y with + | ObjViewAmbiguous a , ObjViewAmbiguous b + | ObjViewFactory a, ObjViewFactory b + | ObjViewOnly a, ObjViewOnly b + | ObjViewFactoryOnly a, ObjViewFactoryOnly b -> + compare_with_loc_name a b + | a, b -> + compare a b + and compare_inline_invoke + { invoke_class = a; invoke_meth = c; invoke_args = e } + { invoke_class = b; invoke_meth = d; invoke_args = f } = + compare_struct (compare_term a b) @@ + lazy (compare_struct (compare_term c d) @@ + lazy (List.compare compare_effective_arg e f)) + and compare_inline_call + { call_fun = a; call_args = c; call_refmod = r1 } + { call_fun = b; call_args = d; call_refmod = r2 } = + compare_struct (compare_with_loc_name a b) @@ + lazy (compare_struct (List.compare compare_effective_arg c d) @@ + lazy (Option.compare compare_refmod r1 r2)) + and compare_effective_arg x y = match x, y with + | ArgExpr a, ArgExpr b -> + compare_expression a b + | ArgExpr _, ArgOmitted -> + 1 + | ArgOmitted, ArgOmitted -> + 0 + | ArgOmitted, ArgExpr _ -> + -1 + and compare_address x y = match x, y with + | DataAddress a, DataAddress b -> + compare_term a b + | ProgAddress a, ProgAddress b -> + compare_term a b + | a, b -> + compare a b + and compare_counter + { counter_kind = a; counter_name = c } + { counter_kind = b; counter_name = d } = + compare_struct (Stdlib.compare a b) @@ + lazy (Option.compare (compare_with_loc_name) c d) + + and compare_ident: ident compare_fun = fun a b -> compare_term a b + + let compare_qualname: qualname compare_fun = compare_term + let compare_literal: literal compare_fun = compare_term + let compare_ident_or_numlit: ident_or_numlit compare_fun = compare_term + let compare_ident_or_alphanum: ident_or_alphanum compare_fun = compare_term + let compare_ident_or_intlit: ident_or_intlit compare_fun = compare_term + let compare_ident_or_literal: ident_or_literal compare_fun = compare_term + let compare_ident_or_nonnum: ident_or_nonnum compare_fun = compare_term + let compare_ident_or_strlit: ident_or_strlit compare_fun = compare_term + let compare_name_or_alphanum: name_or_alphanum compare_fun = compare_term + let compare_name_or_string: name_or_string compare_fun = compare_term + let compare_qualname_or_alphanum: qualname_or_alphanum compare_fun = compare_term + let compare_qualname_or_intlit: qualname_or_intlit compare_fun = compare_term + let compare_qualname_or_literal: qualname_or_literal compare_fun = compare_term + let compare_strlit: strlit compare_fun = compare_term + let compare_strlit_or_intlit: strlit_or_intlit compare_fun = compare_term + + let compare_condition = compare_cond +end +include COMPARE + +(** [major_qualifier qualname] returns [Name name] when [qualname] is + [Qual (..., Qual (_, Name name)) | Name name]*) +let rec major_qualifier_of_qualname qualname = + match (qualname: qualname) with + | Qual (_, qn) -> + major_qualifier_of_qualname qn + | Name n -> n + +(** [qualifier_of_qualname qualname] returns [name] when [qualname] is [Name name] or + [Qual (name, _)] *) +let qualifier_of_qualname: qualname -> name with_loc = function + | Qual (name, _) -> name + | Name name -> name + +(** [list_of_qualname qualname] returns the list [nameN; ...; name1] when qualname is [Qual(name1, ... (Name nameN))], + (note that the major qualifier is first and the minor is last). *) +let list_of_qualname qualname = + let rec aux acc = function + | Qual(n, qn) -> aux (n::acc) qn + | Name n -> n::acc + in + aux [] qualname + + + +(** {2 Manual prettty-printing for terms} *) +module FMT = struct + + open Fmt + + let pp_boolean: boolean Pretty.printer = fun ppf -> function + (* | { bool_width = 0; _ } -> *) + (* string ppf "zero-length-boolean" *) + | { bool_value; _ } -> + string ppf bool_value + + let rec pp_term: type k. k term Pretty.printer = fun ppf -> function + | Alphanum s -> fmt "@[%S:@ alphanum@]" ppf s + | Boolean b -> fmt "@[%a:@ boolean@]" ppf pp_boolean b + | Fixed f -> pp_fixed ppf f + | Floating f -> pp_floating ppf f + | Integer i -> pp_integer ppf i + | National s -> fmt "@[%S:@ national@]" ppf s + | NumFig f -> pp_figurative ppf f + | Fig f -> pp_figurative ppf f + + | Name n -> pp_name' ppf n + | Qual (n, q) -> fmt "%a@ IN@ %a" ppf pp_name' n pp_term q + + | Address i -> pp_address ppf i + | Counter c -> pp_counter ppf c + | InlineCall i -> pp_inline_call ppf i + | InlineInvoke i -> pp_inline_invocation ppf i + | ObjectView o -> pp_object_view ppf o + | ObjectRef o -> pp_object_ref ppf o + | QualIdent i -> pp_qualident ppf i + + | StrConcat (a, b) -> fmt "%a@ &@ %a" ppf pp_term a pp_term b + | Concat (a, b) -> fmt "%a@ &@ %a" ppf pp_term a pp_term b + + and pp_figurative: type k. k figurative Pretty.printer = fun ppf -> function + | Zero -> string ppf "ZERO" + | Space -> string ppf "SPACE" + | Quote -> string ppf "QUOTE" + | LowValue -> fmt "LOW@ VALUE" ppf + | HighValue -> fmt "HIGH@ VALUE" ppf + | All l -> fmt "ALL@ OF@ %a" ppf pp_term l + + and pp_subscript ppf : subscript -> unit = function + | SubSAll -> string ppf "ALL" + | SubSExpr e -> pp_expression ppf e + | SubSIdx (n, s, i) -> fmt "%a@ %a@ %a" ppf pp_name' n pp_sign s pp_integer i + + and pp_refmod ppf { leftmost; length_opt } = + fmt "@[<1>(%a:%a)@]" ppf + pp_expression leftmost + (option pp_expression) length_opt + + and pp_qualident ppf { ident_name = n; ident_refmod; ident_subscripts } = + pp_qualname ppf n; + if ident_subscripts <> [] + then fmt "@[<1>(%a)@]" ppf (list pp_subscript) ident_subscripts; + option pp_refmod ppf ident_refmod + + and pp_qualname ppf = pp_term ppf + + and pp_address ppf = function + | DataAddress i -> fmt "ADDRESS@ OF@ %a" ppf pp_ident i + | ProgAddress i -> fmt "ADDRESS@ OF@ PROGRAM@ %a" ppf pp_term i + + and pp_inline_call ppf { call_fun; call_args; call_refmod } = + fmt "FUNCTION@ %a@ @[<1>(%a)%a@]" ppf pp_name' call_fun + (list ~sep:nop pp_effective_arg) call_args + (option (fun ppf -> fmt "@ %a" ppf pp_refmod)) call_refmod + + and pp_inline_invocation ppf { invoke_class; invoke_meth; invoke_args } = + fmt "%a::%a@ @[<1>(%a)@]" ppf pp_ident invoke_class pp_literal invoke_meth + (list ~sep:nop pp_effective_arg) invoke_args + + and pp_effective_arg ppf = function + | ArgOmitted -> string ppf "OMITTED" + | ArgExpr e -> pp_expression ppf e + + and pp_object_view ppf { object_view_ident; object_view_spec } = + fmt "%a@ AS@ " ppf pp_ident object_view_ident; + match object_view_spec with + | ObjViewAmbiguous n -> pp_name' ppf n + | ObjViewOnly n -> fmt "%a@ ONLY" ppf pp_name' n + | ObjViewFactory n -> fmt "FACTORY@ OF@ %a" ppf pp_name' n + | ObjViewFactoryOnly n -> fmt "FACTORY@ OF@ %a@ ONLY" ppf pp_name' n + | ObjViewUniversal -> string ppf "UNIVERSAL" + + and pp_object_ref ppf = function + | ExceptionObject -> string ppf "EXCEPTION-OBJECT" + | Null -> string ppf "NULL" + | Self -> string ppf "SELF" + | Super None -> string ppf "SUPER" + | Super (Some n) -> fmt "%a@ OF@ SUPER" ppf pp_name' n + + and pp_counter ppf { counter_kind; counter_name } = + let k = match counter_kind with + | LineageCounter -> "LINAGE-COUNTER" + | PageCounter -> "PAGE-COUNTER" + | LineCounter -> "LINE-COUNTER" + in + string ppf k; + Option.iter (fmt "@ OF@ %a" ppf pp_name') counter_name + + and pp_expression ppf = function + | Atom a -> + pp_term ppf a + | Unop (o, e) -> + fmt "@[<1>(%s@ %a)@]" ppf ([%derive.show: unop] o) pp_expression e + | Binop (a, o, b) -> + fmt "@[<1>(%a@ %s@ %a)@]" ppf + pp_expression a ([%derive.show: binop] o) pp_expression b + + and show_unop = function + | UPlus -> "+" + | UMinus -> "-" + | UNot -> "B-NOT" + and pp_unop ppf o = string ppf (show_unop o) + + and show_binop = function + | BPlus -> "+" + | BMinus -> "-" + | BMul -> "*" + | BDiv -> "/" + | BPow -> "**" + | BAnd -> "B-AND" + | BOr -> "B-OR" + | BXor -> "B-XOR" + and pp_binop ppf o = string ppf (show_binop o) + + and pp_cond + : type k. ?pos:_ -> k cond Pretty.printer = fun ?(pos = true) ppf -> function + | Expr e -> + fmt "%a%a" ppf not_ pos pp_expression e + | Relation (a, o, b) -> + fmt "@[<1>%a(%a@ %s@ %a)@]" ppf + not_ pos pp_expression a ([%derive.show: relop] o) pp_expression b + | ClassCond (e, c) -> + fmt "%a@ %a%a" ppf pp_expression e not_ pos pp_class_ c + | SignCond (e, s) -> + fmt "%a@ %a%a" ppf pp_expression e not_ pos pp_sign s + | Omitted e -> + fmt "%a@ %aOMITTED" ppf pp_expression e not_ pos + | Not c -> + pp_cond ~pos:(not pos) ppf c + | Logop (a, o, b) -> + fmt "@[<1>%a(%a@ %a@ %a)@]" ppf + not_ pos (pp_cond ~pos:true) a pp_logop o (pp_cond ~pos:true) b + and pp_condition ppf = pp_cond ppf + and not_ ppf = function false -> fmt "NOT@ " ppf | true -> () + + and show_relop = function + | Gt -> ">" + | Lt -> "<" + | Eq -> "=" + | Ne -> "<>" + | Ge -> ">=" + | Le -> "<=" + and pp_relop ppf o = string ppf (show_relop o) + + and show_class_ = function + | AlphabetOrClass n -> str "%a" pp_name' n + | Alphabetic -> "ALPHABETIC" + | AlphabeticLower -> "ALPHABETIC-LOWER" + | AlphabeticUpper -> "ALPHABETIC-UPPER" + | ClassBoolean -> "BOOLEAN" + | FarthestFromZero -> "FARTHEST-FROM-ZERO" + | FloatInfinity -> "FLOAT-INFINITY" + | FloatNotANumber -> "FLOAT-NOT-A-NUMBER" + | FloatNotANumberQuiet -> "FLOAT-NOT-A-NUMBER-QUIET" + | FloatNotANumberSignaling -> "FLOAT-NOT-A-NUMBER-SIGNALING" + | InArithmeticRange -> "IN-ARITHMETIC-RANGE" + | NearestToZero -> "NEAREST-TO-ZERO" + | ClassNumeric -> "NUMERIC" + and pp_class_ ppf c = string ppf (show_class_ c) + + and pp_sign: type k. k sign_cond Pretty.printer = fun ppf -> function + | SgnPositive -> string ppf "POSITIVE" + | SgnNegative -> string ppf "NEGATIVE" + | SgnZero -> string ppf "ZERO" + and pp_signz ppf = pp_sign ppf + + and pp_logop ppf = function + | LAnd -> string ppf "AND" + | LOr -> string ppf "OR" + + and pp_literal: literal Pretty.printer = fun ppf -> pp_term ppf + and pp_ident: ident Pretty.printer = fun ppf -> pp_term ppf + + (** Pretty-printing for named unions of term types (some are yet to be + renamed) *) + + let pp_ident_or_alphanum: ident_or_alphanum Pretty.printer = pp_term + let pp_ident_or_intlit: ident_or_intlit Pretty.printer = pp_term + let pp_ident_or_literal: ident_or_literal Pretty.printer = pp_term + let pp_ident_or_nonnum: ident_or_nonnum Pretty.printer = pp_term + let pp_ident_or_numlit: ident_or_numlit Pretty.printer = pp_term + let pp_ident_or_strlit: ident_or_strlit Pretty.printer = pp_term + let pp_strlit: strlit Pretty.printer = pp_term + let pp_name_or_string: name_or_string Pretty.printer = pp_term + let pp_name_or_alphanum: name_or_alphanum Pretty.printer = pp_term + let pp_strlit_or_intlit: strlit_or_intlit Pretty.printer = pp_term + let pp_qualname_or_literal: qualname_or_literal Pretty.printer = pp_term + let pp_qualname_or_intlit: qualname_or_intlit Pretty.printer = pp_term + let pp_qualname_or_alphanum: qualname_or_alphanum Pretty.printer = pp_term + +end +include FMT + +module UPCAST = struct + (** Exlicit term upcasting utilities, that should all reduce to identity. *) + + let ident_with_alphanum: ident -> ident_or_alphanum = function + | QualIdent _ as v -> v + | InlineCall _ as v -> v + | InlineInvoke _ as v -> v + | ObjectView _ as v -> v + | ObjectRef _ as v -> v + | Address _ as v -> v + | Counter _ as v -> v + + let ident_with_nonnum: ident -> ident_or_nonnum = function + | QualIdent _ as v -> v + | InlineCall _ as v -> v + | InlineInvoke _ as v -> v + | ObjectView _ as v -> v + | ObjectRef _ as v -> v + | Address _ as v -> v + | Counter _ as v -> v + + let ident_with_numeric: ident -> ident_or_numlit = function + | QualIdent _ as v -> v + | InlineCall _ as v -> v + | InlineInvoke _ as v -> v + | ObjectView _ as v -> v + | ObjectRef _ as v -> v + | Address _ as v -> v + | Counter _ as v -> v + + let ident_with_string: ident -> ident_or_strlit = function + | QualIdent _ as v -> v + | InlineCall _ as v -> v + | InlineInvoke _ as v -> v + | ObjectView _ as v -> v + | ObjectRef _ as v -> v + | Address _ as v -> v + | Counter _ as v -> v + + let ident_with_literal: ident -> ident_or_literal = function + | QualIdent _ as v -> v + | InlineCall _ as v -> v + | InlineInvoke _ as v -> v + | ObjectView _ as v -> v + | ObjectRef _ as v -> v + | Address _ as v -> v + | Counter _ as v -> v + + let ident_with_integer: ident -> ident_or_intlit = function + | QualIdent _ as v -> v + | InlineCall _ as v -> v + | InlineInvoke _ as v -> v + | ObjectView _ as v -> v + | ObjectRef _ as v -> v + | Address _ as v -> v + | Counter _ as v -> v + + let string_with_name: strlit -> name_or_string = function + | Alphanum _ as v -> v + | National _ as v -> v + | Fig _ as v -> v + | StrConcat _ as v -> v + + let string_with_ident: strlit -> ident_or_strlit = function + | Alphanum _ as v -> v + | National _ as v -> v + | Fig _ as v -> v + | StrConcat _ as v -> v + + let numeric_with_ident: numlit -> ident_or_numlit = function + | Integer _ as v -> v + | Fixed _ as v -> v + | Floating _ as v -> v + | NumFig _ as v -> v + + let nonnum_with_ident: nonnumlit -> ident_or_nonnum = function + | Alphanum _ as v -> v + | National _ as v -> v + | Boolean _ as v -> v + | Fig _ as v -> v + | StrConcat _ as v -> v + | Concat _ as v -> v + + let literal_with_ident: literal -> ident_or_literal = function + | Alphanum _ as v -> v + | National _ as v -> v + | Boolean _ as v -> v + | Integer _ as v -> v + | Fixed _ as v -> v + | Floating _ as v -> v + | NumFig _ as v -> v + | Fig _ as v -> v + | StrConcat _ as v -> v + | Concat _ as v -> v + + let literal_with_qualdatname: literal -> qualname_or_literal = function + | Alphanum _ as v -> v + | National _ as v -> v + | Boolean _ as v -> v + | Integer _ as v -> v + | Fixed _ as v -> v + | Floating _ as v -> v + | NumFig _ as v -> v + | Fig _ as v -> v + | StrConcat _ as v -> v + | Concat _ as v -> v + + let qualname_with_alphanum: qualname -> qualname_or_alphanum = function + | Name _ as v -> v + | Qual _ as v -> v + + let qualname_with_literal: qualname -> qualname_or_literal = function + | Name _ as v -> v + | Qual _ as v -> v + + let qualname_with_integer: qualname -> qualname_or_intlit = function + | Name _ as v -> v + | Qual _ as v -> v + + let simple_cond: simple_condition -> condition = function + | Expr _ as c -> c + | Relation _ as c -> c + | ClassCond _ as c -> c + | SignCond _ as c -> c + | Omitted _ as c -> c +end + +type rounded_ident = + { + rounded_ident: ident; + rounded_rounding: rounding; + } +[@@deriving show, ord] + +and rounding = + | RoundingNotAny + | RoundingDefault + | RoundingMode of rounding_mode +[@@deriving show, ord] + +and rounding_mode = + | AwayFromZero + | NearestAwayFromZero + | NearestEven + | NearestTowardZero + | TowardGreater + | TowardLesser + | Truncation + | Prohibited +[@@deriving show, ord] + +and rounded_idents = rounded_ident list +[@@deriving ord] diff --git a/src/lsp/cobol_ast/terms_visitor.ml b/src/lsp/cobol_ast/terms_visitor.ml new file mode 100644 index 000000000..1c20618c3 --- /dev/null +++ b/src/lsp/cobol_ast/terms_visitor.ml @@ -0,0 +1,435 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Visitor +open Cobol_common.Visitor.INFIX (* for `>>` (== `|>`) *) +open Ast + +(* --- *) + +class ['a] folder = object + inherit ['a] Cobol_common.Visitor.Fold.folder + method fold_name: (name, 'a) fold = default + method fold_name': (name with_loc, 'a) fold = default + method fold_ident: (ident, 'a) fold = default + method fold_qualname: (qualname, 'a) fold = default + method fold_qualident: (qualident, 'a) fold = default + method fold_address: (address, 'a) fold = default + method fold_counter: (counter, 'a) fold = default + method fold_counter_kind: (counter_kind, 'a) fold = default + method fold_inline_call: (inline_call, 'a) fold = default + method fold_inline_invocation: (inline_invocation, 'a) fold = default + method fold_effective_arg: (effective_arg, 'a) fold = default + method fold_object_view: (object_view, 'a) fold = default + method fold_object_view_spec: (object_view_spec, 'a) fold = default + method fold_object_ref: (object_ref, 'a) fold = default + method fold_subscript: (subscript, 'a) fold = default + method fold_refmod: (refmod, 'a) fold = default + method fold_sign: (sign, 'a) fold = default + method fold_signz: (signz, 'a) fold = default + method fold_boolean: (boolean, 'a) fold = default + method fold_alphanum: (alphanum, 'a) fold = default + method fold_national: (national, 'a) fold = default + (* method fold_strlit_figurative: (strlit_ figurative, 'a) fold = default *) + (* method fold_intlit: (int_ term, 'a) fold = default *) + method fold_int_figurative: (int_ figurative, 'a) fold = default + method fold_any_figurative: 'k. ('k figurative, 'a) fold = default + (* method fold_figurative: 'k. ('k figurative, 'a) fold = default *) + (* method fold_numlit: (numlit, 'a) fold = default *) + (* method fold_strlit: (strlit, 'a) fold = default *) + (* method fold_literal: (literal, 'a) fold = default *) + (* method fold_ident_or_alphanum: (ident_or_alphanum, 'a) fold = default *) + (* method fold_ident_or_literal: (ident_or_literal, 'a) fold = default *) + method fold_floating: (floating, 'a) fold = default + method fold_fixed: (fixed, 'a) fold = default + method fold_integer: (integer, 'a) fold = default + method fold_binop: (binop, 'a) fold = default + method fold_unop: (unop, 'a) fold = default + method fold_expr: (expression, 'a) fold = default + method fold_class: (class_, 'a) fold = default + method fold_cond: 'k. ('k cond, 'a) fold = default + method fold_simple_cond: (simple_condition, 'a) fold = default + method fold_logop: (logop, 'a) fold = default + method fold_relop: (relop, 'a) fold = default + method fold_rounding_mode: (rounding_mode, 'a) fold = default + method fold_rounding: (rounding, 'a) fold = default + method fold_rounded_ident: (rounded_ident, 'a) fold = default + (* method fold_constant_value: (constant_value, 'a) fold = default *) + (* method fold_constant: (constant, 'a) fold = default *) + (* method fold_constant': (constant with_loc, 'a) fold = default *) + method fold_property_kind: (property_kind, 'a) fold = default + +end + +let fold_name (v: _ #folder) = leaf v#fold_name +let fold_name_opt (v: _ #folder) = fold_option ~fold:fold_name v +let fold_name_list (v: _ #folder) = fold_list ~fold:fold_name v +let fold_name' (v: _ #folder) = + handle' v#fold_name' v ~fold:fold_name + +let fold_name'_opt (v: _ #folder) = fold_option ~fold:fold_name' v +let fold_name'_list (v: _ #folder) = fold_list ~fold:fold_name' v + +let fold_binop (v: _ #folder) = leaf v#fold_binop +let fold_unop (v: _ #folder) = leaf v#fold_unop +let fold_logop (v: _ #folder) = leaf v#fold_logop +let fold_relop (v: _ #folder) = leaf v#fold_relop +let fold_sign (v: _ #folder) = leaf v#fold_sign +let fold_signz (v: _ #folder) = leaf v#fold_signz +let fold_counter_kind (v: _ #folder) = leaf v#fold_counter_kind + +let fold_fixed (v: _ #folder) = leaf v#fold_fixed +let fold_floating (v: _ #folder) = leaf v#fold_floating +let fold_integer (v: _ #folder) = leaf v#fold_integer +let fold_integer_opt (v: _ #folder) = fold_option ~fold:fold_integer v + +let fold_boolean (v: _ #folder) = leaf v#fold_boolean + +let fold_alphanum (v: _ #folder) = + handle v#fold_alphanum ~continue:(fun (Alphanum s) -> fold_string v s) + +let fold_national (v: _ #folder) = + handle v#fold_national ~continue:(fun (National s) -> fold_string v s) + +let fold_counter (v: _ #folder) = + handle v#fold_counter + ~continue:begin fun { counter_kind; counter_name } x -> x + >> fold_counter_kind v counter_kind + >> fold_name'_opt v counter_name + end + +let fold_object_ref (v: _ #folder) = + handle v#fold_object_ref + ~continue:begin function + | ExceptionObject | Null | Self -> Fun.id + | Super s -> fold_name'_opt v s + end + +let rec fold_literal (v: _ #folder) : literal -> 'a -> 'a = function + | Boolean b -> fold_boolean v b + | Fixed _ + | Floating _ + | Integer _ as n -> fold_numlit v n + | National _ as n -> fold_national v n + | NumFig f -> fold_int_figurative v f + | Fig f -> fold_any_figurative v f + | Alphanum _ + | StrConcat _ as s -> fold_strlit v s + | Concat _ as s -> fold_nonnumlit v s + +and fold_intlit (v: _ #folder) : int_ term -> 'a -> 'a = function + | Integer i -> fold_integer v i + | NumFig f -> fold_int_figurative v f + +and fold_numlit (v: _ #folder) : numlit -> 'a -> 'a = function + | Fixed f -> fold_fixed v f + | Floating f -> fold_floating v f + | Integer _ + | NumFig _ as i -> fold_intlit v i + +and fold_nonnumlit (v: _ #folder) : nonnumlit -> 'a -> 'a = function + | Alphanum _ as a -> fold_alphanum v a + | Boolean b -> fold_boolean v b + | National _ as n -> fold_national v n + | Fig f -> fold_any_figurative v f + | StrConcat _ as s -> fold_strlit v s + | Concat _ as n -> fold_nonnumlit v n + +and fold_int_figurative (v: _ #folder) = + leaf v#fold_int_figurative + +and fold_any_figurative (v: _ #folder) = + handle v#fold_any_figurative + ~continue:begin function + | Zero | Space | Quote | LowValue | HighValue -> Fun.id + | All n -> fold_nonnumlit v n + end + +and fold_strlit (v: _ #folder) : strlit -> 'a -> 'a = function + | Alphanum _ as a -> fold_alphanum v a + | National _ as n -> fold_national v n + | Fig f -> fold_any_figurative v f + | StrConcat (s, s') -> fun x -> x >> fold_strlit v s >> fold_strlit v s' + +and fold_ident (v: _ #folder) = + handle v#fold_ident + ~continue:begin function + | Address ai -> fold_address v ai + | Counter c -> fold_counter v c + | InlineCall fi -> fold_inline_call v fi + | InlineInvoke ii -> fold_inline_invocation v ii + | ObjectView ov -> fold_object_view v ov + | ObjectRef po -> fold_object_ref v po + | QualIdent qi -> fold_qualident v qi + end + +and fold_qualident (v: _ #folder) = + handle v#fold_qualident + ~continue:begin fun { ident_name; ident_subscripts; ident_refmod } x -> x + >> fold_qualname v ident_name + >> fold_list ~fold:fold_subscript v ident_subscripts + >> fold_option ~fold:fold_refmod v ident_refmod + end + +and fold_qualname (v: _ #folder) = + handle v#fold_qualname + ~continue:begin function + | Name n -> fold_name' v n + | Qual (n, qn) -> fun x -> x >> fold_name' v n >> fold_qualname v qn + end + +and fold_subscript (v: _ #folder) = + handle v#fold_subscript + ~continue:begin function + | SubSAll -> + Fun.id + | SubSExpr e -> + fold_expr v e + | SubSIdx (n, s, l) -> + fun x -> x >> fold_name' v n >> fold_sign v s >> fold_integer v l + end + +and fold_refmod (v: _ #folder) = + handle v#fold_refmod + ~continue:begin fun { leftmost; length_opt } x -> x + >> fold_expr v leftmost + >> fold_option ~fold:fold_expr v length_opt + end + +and fold_address (v: _ #folder) = + handle v#fold_address + ~continue:begin function + | DataAddress i -> fold_ident v i + | ProgAddress i -> fold_ident_or_literal v i + end + +and fold_inline_call (v: _ #folder) = + handle v#fold_inline_call + ~continue:begin fun { call_fun; call_args; call_refmod } x -> x + >> fold_name' v call_fun + >> fold_list ~fold:fold_effective_arg v call_args + >> fold_option ~fold:fold_refmod v call_refmod + end + +and fold_inline_invocation (v: _ #folder) = + handle v#fold_inline_invocation + ~continue:begin fun { invoke_class; invoke_meth; invoke_args } x -> x + >> fold_ident v invoke_class + >> fold_literal v invoke_meth + >> fold_list ~fold:fold_effective_arg v invoke_args + end + +and fold_effective_arg (v: _ #folder) = + handle v#fold_effective_arg + ~continue:begin function + | ArgExpr e -> fold_expr v e + | ArgOmitted -> Fun.id + end + +and fold_object_view (v: _ #folder) = + handle v#fold_object_view + ~continue:begin fun { object_view_ident; object_view_spec } x -> x + >> fold_ident v object_view_ident + >> fold_object_view_spec v object_view_spec + end + +and fold_object_view_spec (v: _ #folder) = + handle v#fold_object_view_spec + ~continue:begin function + | ObjViewAmbiguous n + | ObjViewFactory n + | ObjViewOnly n + | ObjViewFactoryOnly n -> fold_name' v n + | ObjViewUniversal -> Fun.id + end + +and fold_expr (v: _ #folder) = + handle v#fold_expr + ~continue:begin fun e x -> match e with + | Atom a -> x >> fold_ident_or_literal v a + | Unop (o, e) -> x + >> fold_unop v o + >> fold_expr v e + | Binop (e, o, e') -> x + >> fold_expr v e + >> fold_binop v o + >> fold_expr v e' + end + +and fold_ident_or_literal (v: _ #folder) : ident_or_literal -> 'a -> 'a = function + | Address _ + | Counter _ + | InlineCall _ + | InlineInvoke _ + | ObjectView _ + | ObjectRef _ + | QualIdent _ as i -> fold_ident v i + | Alphanum _ + | Boolean _ + | Fixed _ + | Floating _ + | Integer _ + | National _ + | NumFig _ + | Fig _ + | StrConcat _ + | Concat _ as l -> fold_literal v l + +let fold_class (v: _ #folder) = + handle v#fold_class + ~continue:begin function + | AlphabetOrClass n -> fold_name' v n + | Alphabetic + | AlphabeticLower + | AlphabeticUpper + | ClassBoolean + | FarthestFromZero + | FloatInfinity + | FloatNotANumber + | FloatNotANumberQuiet + | FloatNotANumberSignaling + | InArithmeticRange + | NearestToZero + | ClassNumeric -> Fun.id + end + +let rec fold_cond: type k. _ #folder -> k cond -> _ = fun v -> + handle v#fold_cond + ~continue:begin fun (c: k cond) x -> match c with + | Expr _ | Omitted _ | Relation _ | ClassCond _ | SignCond _ as c -> x + >> fold_simple_cond v c + | Not c -> x + >> fold_cond v c + | Logop (c, l, d) -> x + >> fold_cond v c + >> fold_logop v l + >> fold_cond v d + end + +and fold_simple_cond (v: _ #folder) = + handle v#fold_simple_cond + ~continue:begin fun c x -> match c with + | Expr e | Omitted e -> x + >> fold_expr v e + | Relation (e, r, f) -> x + >> fold_expr v e + >> fold_relop v r + >> fold_expr v f + | ClassCond (e, c) -> x + >> fold_expr v e + >> fold_class v c + | SignCond (e, s) -> x + >> fold_expr v e + >> fold_signz v s + end + +let fold_expression = fold_expr (* alias *) +let fold_condition = fold_cond (* alias *) + +let fold_ident_or_alphanum (v: _ #folder) : ident_or_alphanum -> 'a -> 'a = function + | Alphanum _ as a -> fold_alphanum v a + | Address _ + | Counter _ + | InlineCall _ + | InlineInvoke _ + | ObjectView _ + | ObjectRef _ + | QualIdent _ as i -> fold_ident v i + +let fold_ident_or_intlit (v: _ #folder) : ident_or_intlit -> 'a -> 'a = function + | Address _ + | Counter _ + | InlineCall _ + | InlineInvoke _ + | ObjectView _ + | ObjectRef _ + | QualIdent _ as i -> fold_ident v i + | Integer _ | NumFig _ as i -> fold_intlit v i + +let fold_ident_or_numlit (v: _ #folder) : ident_or_numlit -> 'a -> 'a = function + | Address _ + | Counter _ + | InlineCall _ + | InlineInvoke _ + | ObjectView _ + | ObjectRef _ + | QualIdent _ as i -> fold_ident v i + | Fixed _ | Floating _ + | Integer _ | NumFig _ as i -> fold_numlit v i + +let fold_ident_or_nonnum (v: _ #folder) : ident_or_nonnum -> 'a -> 'a = function + | Address _ + | Counter _ + | InlineCall _ + | InlineInvoke _ + | ObjectView _ + | ObjectRef _ + | QualIdent _ as i -> fold_ident v i + | Alphanum _ + | Boolean _ + | National _ + | Concat _ + | StrConcat _ + | Fig _ as f -> fold_literal v f + +let fold_ident_or_strlit (v: _ #folder) : ident_or_strlit -> 'a -> 'a = function + | Address _ + | Counter _ + | InlineCall _ + | InlineInvoke _ + | ObjectView _ + | ObjectRef _ + | QualIdent _ as i -> fold_ident v i + | Alphanum _ + | National _ + | Fig _ + | StrConcat _ as s -> fold_strlit v s + +let fold_qualname_or_alphanum (v: _ #folder) : qualname_or_alphanum -> _ = function + | Name _ | Qual _ as qn -> fold_qualname v qn + | Alphanum _ as a -> fold_alphanum v a + +let fold_qualname_or_intlit (v: _ #folder) : qualname_or_intlit -> _ = function + | Name _ | Qual _ as qn -> fold_qualname v qn + | Integer _ | NumFig _ as i -> fold_intlit v i + +let fold_qualname' (v: _ #folder) = fold' ~fold:fold_qualname v +let fold_qualname_opt (v: _ #folder) = fold_option ~fold:fold_qualname v +let fold_qualname'_opt (v: _ #folder) = fold_option ~fold:fold_qualname' v +let fold_strlit_opt (v: _ #folder) = fold_option ~fold:fold_strlit v +let fold_literal_opt (v: _ #folder) = fold_option ~fold:fold_literal v +let fold_ident' (v: _ #folder) = fold' ~fold:fold_ident v +let fold_ident'_opt (v: _ #folder) = fold_option ~fold:fold_ident' v + +let fold_rounding_mode (v: _ #folder) = + leaf v#fold_rounding_mode + +let fold_rounding (v: _ #folder) = + handle v#fold_rounding + ~continue:begin function + | RoundingMode m -> fold_rounding_mode v m + | RoundingNotAny | RoundingDefault -> Fun.id + end + +let fold_rounded_ident (v: _ #folder) = + handle v#fold_rounded_ident + ~continue: begin fun { rounded_ident; rounded_rounding } x -> x + >> fold_ident v rounded_ident + >> fold_rounding v rounded_rounding + end + +let fold_rounded_idents (v: _ #folder) = + fold_list ~fold:fold_rounded_ident v + +let fold_property_kind (v: _ #folder) = + leaf v#fold_property_kind diff --git a/src/lsp/cobol_ast/traversal.ml b/src/lsp/cobol_ast/traversal.ml new file mode 100644 index 000000000..eb653ad80 --- /dev/null +++ b/src/lsp/cobol_ast/traversal.ml @@ -0,0 +1,896 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* NB: broken, but possibly obsolete. *) + +(* +open Cobol_common.Srcloc.INFIX +open Cobol_common.Basics +open Ast + +(** This module implements the functors let module types to make mapfolder from one + implementation of {!Cobol_ptree.Make} to another. *) + +module Make_data_sections_traversal + (Data_sec_in: DATA_SECTIONS_AST) + (Data_sec_out: DATA_SECTIONS_AST) + (Default_map: sig + val picture: Data_sec_in.Pic_repr.picture -> Data_sec_out.Pic_repr.picture + end) = +struct + (** This functor makes a mapfolder from {!In} to {!Out}, using {!Annot_map} to map the different + representations from {!In} to {!Out}. *) + open Data_sec_in + open Data_sec_out + + (** This type is used to specify the types of the mapfold functions, ['a] is the type of + the accumulator, ['b] is the type of the AST node that is given as input and + ['c] is the type of the AST node that is given as output. *) + type ('a, 'b, 'c) fm_fun = 'a fm_funs -> 'a -> 'b -> 'c * 'a + + (** This type is used to specify functions where the returns ast type does not change from the + one that was given as input *) + and ('a, 'b) fm_id_fun = ('a, 'b, 'b) fm_fun + + (** This record type is used to implement the mapfolder functions. *) + and 'a fm_funs = { + environment_division: ('a, environment_division with_loc, environment_division with_loc) fm_fun; + configuration_section: ('a, configuration_section) fm_id_fun; + input_output_section: ('a, input_output_section) fm_id_fun; + special_names_paragraph: ('a, special_names_paragraph) fm_id_fun; + currency_sign: ('a, currency_sign with_loc) fm_id_fun; + decimal_point: ('a, decimal_point with_loc) fm_id_fun; + condition_name_entry: ('a, condition_name_entry with_loc) fm_id_fun; + rename_entry: ('a, rename_entry with_loc) fm_id_fun; + qualname: ('a, qualname) fm_id_fun; + data_name: ('a, entry_name option with_loc) fm_id_fun; + level: ('a, integer) fm_id_fun; + redefines_clause: ('a, redefines_clause with_loc) fm_id_fun; + picture_clause: ('a, Data_sec_in.picture_clause with_loc, Data_sec_out.picture_clause with_loc) fm_fun; + data_description_clause: ('a, Data_sec_in.data_description_clause with_loc, Data_sec_out.data_description_clause with_loc) fm_fun; + screen_description_clause: ('a, Data_sec_in.screen_description_clause with_loc, Data_sec_out.screen_description_clause with_loc) fm_fun; + report_group_description_clause: ('a, Data_sec_in.report_group_description_clause with_loc, Data_sec_out.report_group_description_clause with_loc) fm_fun; + data_description_entry: ('a, Data_sec_in.data_description_entry with_loc, Data_sec_out.data_description_entry with_loc) fm_fun; + report_group_description_entry: ('a, Data_sec_in.report_group_description_entry, Data_sec_out.report_group_description_entry) fm_fun; + screen_description_entry: ('a, Data_sec_in.screen_description_entry, Data_sec_out.screen_description_entry) fm_fun; + constant_or_data_description_entry: ('a, Data_sec_in.constant_or_data_description_entry with_loc, Data_sec_out.constant_or_data_description_entry with_loc) fm_fun; + file_description_entry: ('a, Data_sec_in.file_description_entry, Data_sec_out.file_description_entry) fm_fun; + sort_merge_description_entry: ('a, Data_sec_in.sort_merge_description_entry, Data_sec_out.sort_merge_description_entry) fm_fun; + input_communication_entry: ('a, Data_sec_in.input_communication_entry, Data_sec_out.input_communication_entry) fm_fun; + io_communication_entry: ('a, Data_sec_in.io_communication_entry, Data_sec_out.io_communication_entry) fm_fun; + output_communication_entry: ('a, Data_sec_in.output_communication_entry, Data_sec_out.output_communication_entry) fm_fun; + communication_description_entry: ('a, Data_sec_in.communication_description_entry with_loc, Data_sec_out.communication_description_entry with_loc) fm_fun; + constant_or_report_group_description_entry: ('a, Data_sec_in.constant_or_report_group_description_entry with_loc, Data_sec_out.constant_or_report_group_description_entry with_loc) fm_fun; + report_description_entry: ('a, Data_sec_in.report_description_entry with_loc, Data_sec_out.report_description_entry with_loc) fm_fun; + constant_or_screen_description_entry: ('a, Data_sec_in.constant_or_screen_description_entry with_loc, Data_sec_out.constant_or_screen_description_entry with_loc) fm_fun; + file_or_sort_merge_description_entry: ('a, Data_sec_in.file_or_sort_merge_description_entry with_loc, Data_sec_out.file_or_sort_merge_description_entry with_loc) fm_fun; + } + + let fm_environment_division funs acc v = + funs.environment_division funs acc v + + let fm_configuration_section funs acc v = + funs.configuration_section funs acc v + + let fm_input_output_section funs acc v = + funs.input_output_section funs acc v + + let fm_special_names_paragraph funs acc v = + funs.special_names_paragraph funs acc v + + let fm_currency_sign funs acc v = + funs.currency_sign funs acc v + + let fm_decimal_point funs acc v = + funs.decimal_point funs acc v + + let fm_condition_name_entry funs acc v = + funs.condition_name_entry funs acc v + + let fm_rename_entry funs acc v = + funs.rename_entry funs acc v + + let fm_qualname funs acc v = + funs.qualname funs acc v + + let fm_data_name funs acc v = + funs.data_name funs acc v + + let fm_level funs acc v = + funs.level funs acc v + + let fm_redefines_clause funs acc v = + funs.redefines_clause funs acc v + + let fm_picture_clause funs acc v = + funs.picture_clause funs acc v + + let fm_data_description_clause funs acc v = + funs.data_description_clause funs acc v + + let fm_screen_description_clause funs acc v = + funs.screen_description_clause funs acc v + + let fm_report_group_description_clause funs acc v = + funs.report_group_description_clause funs acc v + + let fm_data_description_entry funs acc v = + funs.data_description_entry funs acc v + + let fm_report_group_description_entry funs acc v = + funs.report_group_description_entry funs acc v + + let fm_screen_description_entry funs acc v = + funs.screen_description_entry funs acc v + + let fm_constant_or_data_description_entry funs acc v = + funs.constant_or_data_description_entry funs acc v + + let fm_file_description_entry funs acc v = + funs.file_description_entry funs acc v + + let fm_sort_merge_description_entry funs acc v = + funs.sort_merge_description_entry funs acc v + + let fm_input_communication_entry funs acc v = + funs.input_communication_entry funs acc v + + let fm_io_communication_entry funs acc v = + funs.io_communication_entry funs acc v + + let fm_output_communication_entry funs acc v = + funs.output_communication_entry funs acc v + + let fm_communication_description_entry funs acc v = + funs.communication_description_entry funs acc v + + let fm_constant_or_report_group_description_entry funs acc v = + funs.constant_or_report_group_description_entry funs acc v + + let fm_report_description_entry funs acc v = + funs.report_description_entry funs acc v + + let fm_constant_or_screen_description_entry funs acc v = + funs.constant_or_screen_description_entry funs acc v + + let fm_file_or_sort_merge_description_entry funs acc v = + funs.file_or_sort_merge_description_entry funs acc v + + let nop _ x y = + y, x + + let environment_division funs acc (ed: environment_division with_loc) = + let configuration_section, acc = + (~&ed.configuration_section, acc) >>= fm_configuration_section funs + in + let input_output_section, acc = + (~&ed.input_output_section, acc) >>= fm_input_output_section funs + in + { + configuration_section; + input_output_section; + } &@<- ed, acc + + let configuration_section funs acc (cs: configuration_section) = + let special_names_paragraph, acc = + (cs.special_names_paragraph, acc) >>= fm_special_names_paragraph funs + in + {cs with + special_names_paragraph; + }, acc + + let input_output_section = nop + + let special_names_paragraph funs acc (snp: special_names_paragraph) = + LIST.foldmap (snp, acc) ~f:(fun acc (sncl_loc) -> + match ~&sncl_loc with + | CurrencySign cs -> + let cs, acc = fm_currency_sign funs acc (cs &@<- sncl_loc) in + (CurrencySign ~&cs &@<- cs), acc + | DecimalPoint dp -> + let dp, acc = fm_decimal_point funs acc (dp &@<- sncl_loc) in + (DecimalPoint ~&dp &@<- dp), acc + | _ -> + sncl_loc, acc) + + let qualname = nop + + let data_name = nop + + let level = nop + + let decimal_point = nop + + let currency_sign = nop + + let condition_name_entry = nop + + let rename_entry funs acc re_loc = + let re = ~&re_loc in + let renamed_item, acc = fm_qualname funs acc (re.renamed_item) in + let through_opt, acc = (re.through_opt, acc) >>= fm_qualname funs in + {re with + renamed_item; + through_opt + } &@<- re_loc, acc + + let redefines_clause = nop + + let picture_clause _funs acc (pc: Data_sec_in.picture_clause with_loc) = + let picture = Default_map.picture (~&pc).picture in + { + picture; + locale_opt = ~&pc.locale_opt; + } &@<- pc, acc + + let data_description_clause funs acc ddc = + match ~&ddc with + | Data_sec_in.Aligned -> + Aligned &@<- ddc, acc + | AnyLength -> + AnyLength &@<- ddc, acc + | Based -> + Based &@<- ddc, acc + | BlankWhenZero -> + (BlankWhenZero: data_description_clause) &@<- ddc, acc + | ConstantRecord -> + ConstantRecord &@<- ddc, acc + | DataOccurs do_ -> + DataOccurs do_ &@<- ddc, acc + | DataType dt -> + DataType dt &@<- ddc, acc + | DataValue dv -> + DataValue dv &@<- ddc, acc + | DynamicLength dl -> + DynamicLength dl &@<- ddc, acc + | External e -> + External e &@<- ddc, acc + | Global -> + (Global: data_description_clause) &@<- ddc, acc + | GroupUsage gu -> + GroupUsage gu &@<- ddc, acc + | Justified -> + (Justified: data_description_clause) &@<- ddc, acc + | Picture p -> + let picture_clause, acc = fm_picture_clause funs acc (p &@<- ddc) in + (Picture ~&picture_clause: data_description_clause) &@<- picture_clause, acc + | Property p -> + Property p &@<- ddc, acc + | Redefines r -> + let redefines_clause, acc = fm_redefines_clause funs acc (r &@<- ddc) in + Redefines ~&redefines_clause &@<- ddc, acc + | SameAs sa -> + SameAs sa &@<- ddc, acc + | SelectWhen sw -> + SelectWhen sw &@<- ddc, acc + | Sign s -> + (Sign s: data_description_clause) &@<- ddc, acc + | Synchronized s -> + Synchronized s &@<- ddc, acc + | Typedef t -> + Typedef t &@<- ddc, acc + | Usage u -> + Usage u &@<- ddc, acc + | Validation v -> + Validation v &@<- ddc, acc + + let report_group_description_clause funs acc rgde = + match ~&rgde with + | Data_sec_in.ReportType rt -> + ReportType rt &@<- rgde, acc + | NextGroup ng -> + NextGroup ng &@<- rgde, acc + | ReportLine rl -> + ReportLine rl &@<- rgde, acc + | Picture p -> + let picture_clause, acc = fm_picture_clause funs acc (p &@<- rgde) in + (Picture ~&picture_clause: report_group_description_clause) &@<- rgde, acc + | ReportScreenUsage rsu -> + (ReportScreenUsage rsu: report_group_description_clause) &@<- rgde, acc + | Sign s -> + (Sign s: report_group_description_clause) &@<- rgde, acc + | Justified -> + (Justified: report_group_description_clause) &@<- rgde, acc + | ReportColumn rc -> + ReportColumn rc &@<- rgde, acc + | BlankWhenZero -> + (BlankWhenZero: report_group_description_clause) &@<- rgde, acc + | Source s -> + Source s &@<- rgde, acc + | Sum s -> + Sum s &@<- rgde, acc + | ReportValue rv -> + ReportValue rv &@<- rgde, acc + | PresentWhen pw -> + PresentWhen pw &@<- rgde, acc + | GroupIndicate -> + GroupIndicate &@<- rgde, acc + | ReportOccurs ro -> + ReportOccurs ro &@<- rgde, acc + | Varying v -> + Varying v &@<- rgde, acc + + let screen_description_clause funs acc sdc = + match ~&sdc with + | Data_sec_in.Auto -> + Auto &@<- sdc, acc + | Blank b -> + Blank b &@<- sdc, acc + | BlankWhenZero -> + BlankWhenZero &@<- sdc, acc + | Erase e -> + Erase e &@<- sdc, acc + | Full -> + (Full: screen_description_clause) &@<- sdc, acc + | Global -> + Global &@<- sdc, acc + | Justified -> + Justified &@<- sdc, acc + | Picture p -> + let picture_clause, acc = fm_picture_clause funs acc (p &@<- sdc) in + Picture ~&picture_clause &@<- sdc, acc + | ReportScreenUsage rsu -> + ReportScreenUsage rsu &@<- sdc, acc + | Required -> + Required &@<- sdc, acc + | ScreenAttribute ra -> + ScreenAttribute ra &@<- sdc, acc + | ScreenColumn rc -> + ScreenColumn rc &@<- sdc, acc + | ScreenLine sl -> + ScreenLine sl &@<- sdc, acc + | ScreenOccurs so -> + ScreenOccurs so &@<- sdc, acc + | Secure -> + Secure &@<- sdc, acc + | Sign s -> + Sign s &@<- sdc, acc + | SourceDestination sd -> + SourceDestination sd &@<- sdc, acc + + let data_description_entry funs acc (dde: Data_sec_in.data_description_entry with_loc) = + let level, acc = fm_level funs acc ~&dde.level in + let data_name, acc = fm_data_name funs acc ~&dde.data_name in + let data_description_clauses, acc = + LIST.foldmap (~&dde.data_description_clauses, acc) ~f:(fm_data_description_clause funs) + in + { + level; + data_name; + data_description_clauses; + } &@<- dde, acc + + let report_group_description_entry funs acc (rgde: Data_sec_in.report_group_description_entry) = + let report_group_description_clauses, acc = + LIST.foldmap (rgde.report_group_description_clauses, acc) + ~f:(fm_report_group_description_clause funs) + in + { + level = rgde.level; + data_name = rgde.data_name; + report_group_description_clauses + }, acc + + let screen_description_entry funs acc (sde: Data_sec_in.screen_description_entry) = + let screen_description_clauses, acc = + LIST.foldmap (sde.screen_description_clauses, acc) + ~f:(fm_screen_description_clause funs) + in + { + level = sde.level; + data_name = sde.data_name; + screen_description_clauses; + }, acc + + let constant_or_data_description_entry funs acc cdde = + match ~&cdde with + | (Data_sec_in.Constant ce: Data_sec_in.constant_or_data_description_entry) -> + (Constant ce: constant_or_data_description_entry) &@<- cdde, acc + | Data dde -> + let dde, acc = fm_data_description_entry funs acc (dde &@<- cdde) in + (Data ~&dde: constant_or_data_description_entry) &@<- cdde, acc + | Renames re -> + let re, acc = fm_rename_entry funs acc (re &@<- cdde) in + (Renames ~&re: constant_or_data_description_entry) &@<- cdde, acc + | CondName cde -> + let cde, acc = fm_condition_name_entry funs acc (cde &@<- cdde) in + (CondName ~&cde: constant_or_data_description_entry) &@<- cdde, acc + + let file_description_entry funs acc (fde: Data_sec_in.file_description_entry) = + let constant_or_data_descriptions, acc = + LIST.foldmap (fde.constant_or_data_descriptions, acc) + ~f:(fm_constant_or_data_description_entry funs) + in + { + file_name = fde.file_name; + file_descriptions = fde.file_descriptions; + constant_or_data_descriptions; + }, acc + + let sort_merge_description_entry funs acc (smde: Data_sec_in.sort_merge_description_entry) = + let constant_or_data_descriptions, acc = + LIST.foldmap (smde.constant_or_data_descriptions, acc) + ~f:(fm_constant_or_data_description_entry funs) + in + { + file_name = smde.file_name; + sort_merge_file_descriptions = smde.sort_merge_file_descriptions; + constant_or_data_descriptions; + }, acc + + let input_communication_entry funs acc (ice: Data_sec_in.input_communication_entry) = + let constant_or_data_descriptions, acc = + LIST.foldmap (ice.constant_or_data_descriptions, acc) + ~f:(fm_constant_or_data_description_entry funs) + in + ({ + cd_name = ice.cd_name; + initial = ice.initial; + communication_descriptions = ice.communication_descriptions; + data_items = ice.data_items; + constant_or_data_descriptions; + }: input_communication_entry), acc + + let io_communication_entry funs acc (ice: Data_sec_in.io_communication_entry) = + let constant_or_data_descriptions, acc = + LIST.foldmap (ice.constant_or_data_descriptions, acc) + ~f:(fm_constant_or_data_description_entry funs) + in + { + cd_name = ice.cd_name; + initial = ice.initial; + communication_descriptions = ice.communication_descriptions; + data_items = ice.data_items; + constant_or_data_descriptions; + }, acc + + let output_communication_entry funs acc (oce: Data_sec_in.output_communication_entry) = + let constant_or_data_descriptions, acc = + LIST.foldmap (oce.constant_or_data_descriptions, acc) + ~f:(fm_constant_or_data_description_entry funs) + in + { + cd_name = oce.cd_name; + communication_descriptions = oce.communication_descriptions; + constant_or_data_descriptions; + }, acc + + let communication_description_entry funs acc cde = + match ~&cde with + | Data_sec_in.(Input i) -> + let i, acc = fm_input_communication_entry funs acc i in + Input i &@<- cde, acc + | Output o -> + let o, acc = fm_output_communication_entry funs acc o in + Output o &@<- cde, acc + | IO io -> + let io, acc = fm_io_communication_entry funs acc io in + IO io &@<- cde, acc + + let constant_or_report_group_description_entry funs acc crgde = + match ~&crgde with + | (Data_sec_in.Constant ce: Data_sec_in.constant_or_report_group_description_entry) -> + (Constant ce: constant_or_report_group_description_entry) &@<- crgde, acc + | ReportGroup rg -> + let rg, acc = fm_report_group_description_entry funs acc rg in + ReportGroup rg &@<- crgde, acc + + let report_description_entry funs acc (rde: Data_sec_in.report_description_entry with_loc) = + let constant_or_report_group_descriptions, acc = + LIST.foldmap (~&rde.constant_or_report_group_descriptions, acc) + ~f:(fm_constant_or_report_group_description_entry funs) + in + { + report_name = ~&rde.report_name; + report_descriptions = ~&rde.report_descriptions; + constant_or_report_group_descriptions; + } &@<- rde, acc + + let constant_or_screen_description_entry funs acc csde = + match ~&csde with + | Data_sec_in.(Constant ce) -> + Constant ce &@<- csde, acc + | Screen sde -> + let sde, acc = fm_screen_description_entry funs acc sde in + Screen sde &@<- csde, acc + + let file_or_sort_merge_description_entry funs acc fsmde = + match ~&fsmde with + | Data_sec_in.(File fde) -> + let fde, acc = fm_file_description_entry funs acc fde in + File fde &@<- fsmde, acc + | SortMergeFile smf -> + let smf, acc = fm_sort_merge_description_entry funs acc smf in + SortMergeFile smf &@<- fsmde, acc + (** This record contains the functions with the default behaviour of the mapfolder (do nothing) except + for the picture where it applies the transformation provided by {!Annot_map.picture_repr}. *) + let fm_default: 'a fm_funs = { + environment_division; + configuration_section; + input_output_section; + special_names_paragraph; + currency_sign; + decimal_point; + condition_name_entry; + rename_entry; + qualname; + data_name; + level; + redefines_clause; + picture_clause; + data_description_clause; + screen_description_clause; + report_group_description_clause; + data_description_entry; + report_group_description_entry; + screen_description_entry; + constant_or_data_description_entry; + file_description_entry; + sort_merge_description_entry; + input_communication_entry; + io_communication_entry; + output_communication_entry; + communication_description_entry; + constant_or_report_group_description_entry; + report_description_entry; + constant_or_screen_description_entry; + file_or_sort_merge_description_entry; + } + +end + +module Make_data_div_traversal + (Data_div_in: DATA_DIVISION_AST) + (Data_div_out: DATA_DIVISION_AST) + (Default_map: sig + val file_section: Data_div_in.file_section -> Data_div_out.file_section + val working_storage_section: Data_div_in.working_storage_section -> Data_div_out.working_storage_section + val linkage_section: Data_div_in.linkage_section -> Data_div_out.linkage_section + val communication_section: Data_div_in.communication_section -> Data_div_out.communication_section + val local_storage_section: Data_div_in.local_storage_section -> Data_div_out.local_storage_section + val report_section: Data_div_in.report_section -> Data_div_out.report_section + val screen_section: Data_div_in.screen_section -> Data_div_out.screen_section + end) + = +struct + (** This functor makes a mapfolder from {!In} to {!Out}, using {!Annot_map} to map the different + representations from {!In} to {!Out}. *) + module Data_div_in = Data_div_in + module Data_div_out = Data_div_out + + open Data_div_in + open Data_div_out + + + (** This type is used to specify the types of the mapfold functions, ['a] is the type of + the accumulator, ['b] is the type of the AST node that is given as input and + ['c] is the type of the AST node that is given as output. *) + type ('a, 'b, 'c) fm_fun = 'a fm_funs -> 'a -> 'b -> 'c * 'a + + (** This type is used to specify functions where the returns ast type does not change from the + one that was given as input *) + and ('a, 'b) fm_id_fun = ('a, 'b, 'b) fm_fun + + (** This record type is used to implement the mapfolder functions. *) + and 'a fm_funs = { + data_division: ('a,Data_div_in.data_division with_loc, Data_div_out.data_division with_loc) fm_fun; + file_section: ('a, Data_div_in.file_section, Data_div_out.file_section) fm_fun; + working_storage_section: ('a, Data_div_in.working_storage_section, Data_div_out.working_storage_section) fm_fun; + linkage_section: ('a, Data_div_in.linkage_section, Data_div_out.linkage_section) fm_fun; + communication_section: ('a, Data_div_in.communication_section, Data_div_out.communication_section) fm_fun; + local_storage_section: ('a, Data_div_in.local_storage_section, Data_div_out.local_storage_section) fm_fun; + report_section: ('a, Data_div_in.report_section, Data_div_out.report_section) fm_fun; + screen_section: ('a, Data_div_in.screen_section, Data_div_out.screen_section) fm_fun; + } + + let fm_data_division funs acc v = + funs.data_division funs acc v + + let fm_file_section funs acc v = + funs.file_section funs acc v + + let fm_working_storage_section funs acc v = + funs.working_storage_section funs acc v + + let fm_linkage_section funs acc v = + funs.linkage_section funs acc v + + let fm_communication_section funs acc v = + funs.communication_section funs acc v + + let fm_local_storage_section funs acc v = + funs.local_storage_section funs acc v + + let fm_report_section funs acc v = + funs.report_section funs acc v + + let fm_screen_section funs acc v = + funs.screen_section funs acc v + + let nop _ x y = + y, x + + let qualname = nop + + let data_name = nop + + let level = nop + + let file_section _funs acc fs = + Default_map.file_section fs, acc + + let working_storage_section _funs acc wss = + Default_map.working_storage_section wss, acc + + let linkage_section _funs acc ls = + Default_map.linkage_section ls, acc + + let communication_section _funs acc cs = + Default_map.communication_section cs, acc + + let local_storage_section _funs acc lss = + Default_map.local_storage_section lss, acc + + let report_section _funs acc rs = + Default_map.report_section rs, acc + + let screen_section _funs acc ss = + Default_map.screen_section ss, acc + + let data_division funs acc (dd:Data_div_in.data_division with_loc) = + let file_section, acc = + (~&dd.file_section, acc) >>= fm_file_section funs + in + let working_storage_section, acc = + (~&dd.working_storage_section, acc) >>= fm_working_storage_section funs + in + let linkage_section, acc = + (~&dd.linkage_section, acc) >>= fm_linkage_section funs + in + let communication_section, acc = + (~&dd.communication_section, acc) >>= fm_communication_section funs + in + let local_storage_section, acc = + (~&dd.local_storage_section, acc) >>= fm_local_storage_section funs + in + let report_section, acc = + (~&dd.report_section, acc) >>= fm_report_section funs + in + let screen_section, acc = + (~&dd.screen_section, acc) >>= fm_screen_section funs + in + { + file_section; + working_storage_section; + linkage_section; + communication_section; + local_storage_section; + report_section; + screen_section; + } &@<- dd, acc + + (** This record contains the functions with the default behaviour of the mapfolder (do nothing) except + for the picture where it applies the transformation provided by {!Annot_map.picture_repr}. *) + let fm_default: 'a fm_funs = { + data_division; + file_section; + working_storage_section; + linkage_section; + communication_section; + local_storage_section; + report_section; + screen_section; + } + +end + +module Make + (AstIn: Ast.S) + (AstOut: Ast.S) + (Default_map: sig + val picture: AstIn.Data_section.Pic_repr.picture -> AstOut.Data_section.Pic_repr.picture + val file_section: AstIn.Data_div.file_section -> AstOut.Data_div.file_section + val working_storage_section: AstIn.Data_div.working_storage_section -> AstOut.Data_div.working_storage_section + val linkage_section: AstIn.Data_div.linkage_section -> AstOut.Data_div.linkage_section + val communication_section: AstIn.Data_div.communication_section -> AstOut.Data_div.communication_section + val local_storage_section: AstIn.Data_div.local_storage_section -> AstOut.Data_div.local_storage_section + val report_section: AstIn.Data_div.report_section -> AstOut.Data_div.report_section + val screen_section: AstIn.Data_div.screen_section -> AstOut.Data_div.screen_section + end) + = +struct + (** This functor makes a mapfolder from {!In} to {!Out}, using {!Annot_map} to map the different + representations from {!In} to {!Out}. *) + module Data_sec_traversal = Make_data_sections_traversal (AstIn.Data_section) (AstOut.Data_section) (struct + let picture = Default_map.picture end) + module Data_div_traversal = Make_data_div_traversal (AstIn.Data_div) (AstOut.Data_div) (struct + let file_section = Default_map.file_section + let working_storage_section = Default_map.working_storage_section + let linkage_section = Default_map.linkage_section + let communication_section = Default_map.communication_section + let local_storage_section = Default_map.local_storage_section + let report_section = Default_map.report_section + let screen_section = Default_map.screen_section + end) + + open AstOut + (** This type is used to specify the types of the mapfold functions, ['a] is the type of + the accumulator, ['b] is the type of the AST node that is given as input and + ['c] is the type of the AST node that is given as output. *) + type ('a, 'b, 'c) fm_fun = 'a fm_funs -> 'a -> 'b -> 'c * 'a + + (** This type is used to specify functions where the returns ast type does not change from the + one that was given as input *) + and ('a, 'b) fm_id_fun = ('a, 'b, 'b) fm_fun + + (** This record type is used to implement the mapfolder functions. *) + and 'a fm_funs = { + compilation_group: ('a, AstIn.compilation_group, AstOut.compilation_group) fm_fun; + compilation_unit: ('a, AstIn.compilation_unit with_loc, AstOut.compilation_unit with_loc) fm_fun; + program_definition: ('a, AstIn.program_definition, AstOut.program_definition) fm_fun; + program_prototype: ('a, AstIn.program_prototype, AstOut.program_prototype) fm_fun; + function_definition: ('a, AstIn.function_definition, AstOut.function_definition) fm_fun; + function_prototype: ('a, AstIn.function_prototype, AstOut.function_prototype) fm_fun; + data_sec_traversal_funs: 'a Data_sec_traversal.fm_funs; + data_div_traversal_funs: 'a Data_div_traversal.fm_funs; + } + + let fm_compilation_group funs acc cg = + funs.compilation_group funs acc cg + + let fm_compilation_unit funs acc cu = + funs.compilation_unit funs acc cu + + let fm_program_definition funs acc pd = + funs.program_definition funs acc pd + + let fm_program_prototype funs acc pp = + funs.program_prototype funs acc pp + + let fm_function_definition funs acc fd = + funs.function_definition funs acc fd + + let fm_function_prototype funs acc fp = + funs.function_prototype funs acc fp + + let nop _ x y = + y, x + + let function_prototype funs acc (fp: AstIn.function_prototype) = + let environment_division, acc = + (fp.environment_division, acc) + >>= (Data_sec_traversal.fm_environment_division funs.data_sec_traversal_funs) + in + let data_division, acc = + (fp.data_division, acc) + >>= Data_div_traversal.fm_data_division funs.data_div_traversal_funs + in + { + function_prototype_id_paragraph = fp.function_prototype_id_paragraph; + options_paragraph = fp.options_paragraph; + environment_division; + data_division; + procedure_division = fp.procedure_division; + end_function = fp.end_function; + }, acc + + let function_definition funs acc (fd: AstIn.function_definition) = + let environment_division, acc = + (fd.environment_division, acc) + >>= (Data_sec_traversal.fm_environment_division funs.data_sec_traversal_funs) + in + let data_division, acc = + (fd.data_division, acc) + >>= Data_div_traversal.fm_data_division funs.data_div_traversal_funs + in + { + function_id_paragraph = fd.function_id_paragraph; + options_paragraph = fd.options_paragraph; + environment_division; + data_division; + procedure_division = fd.procedure_division; + end_function = fd.end_function; + }, acc + + let program_prototype funs acc (pp: AstIn.program_prototype) = + let environment_division, acc = + (pp.environment_division, acc) + >>= (Data_sec_traversal.fm_environment_division funs.data_sec_traversal_funs) + in + let data_division, acc = + (pp.data_division, acc) + >>= Data_div_traversal.fm_data_division funs.data_div_traversal_funs + in + { + program_prototype_id_paragraph = pp.program_prototype_id_paragraph; + options_paragraph = pp.options_paragraph; + environment_division; + data_division; + procedure_division = pp.procedure_division; + end_program = pp.end_program; + }, acc + + let program_definition funs acc (pd: AstIn.program_definition) = + let environment_division, acc = + (pd.environment_division, acc) + >>= (Data_sec_traversal.fm_environment_division funs.data_sec_traversal_funs) + in + let data_division, acc = + (pd.data_division, acc) + >>= Data_div_traversal.fm_data_division funs.data_div_traversal_funs + in + let nested_programs, acc = + LIST.foldmap (pd.nested_programs, acc) ~f:(fun acc np_loc -> + let np, acc = fm_program_definition funs acc ~&np_loc in + np &@<- np_loc, acc) + in + { + has_identification_division = pd.has_identification_division; + program_id_paragraph = pd.program_id_paragraph; + informational_paragraphs = pd.informational_paragraphs; + options_paragraph = pd.options_paragraph; + environment_division; + data_division; + procedure_division = pd.procedure_division; + nested_programs; + end_program = pd.end_program; + }, acc + + let compilation_unit funs acc cu = + match ~&cu with + | AstIn.ProgramDefinition (pd) -> + let pd, acc = fm_program_definition funs acc pd in + (ProgramDefinition pd) &@<- cu, acc + | ProgramPrototype (pp) -> + let pp, acc = fm_program_prototype funs acc pp in + (ProgramPrototype pp) &@<- cu, acc + | FunctionDefinition (fd) -> + let fd, acc = fm_function_definition funs acc fd in + (FunctionDefinition fd) &@<- cu, acc + | FunctionPrototype (fp) -> + let fp, acc = fm_function_prototype funs acc fp in + (FunctionPrototype fp) &@<- cu, acc + | _ -> failwith "Not implemented yet" + + let compilation_group funs acc (cg: AstIn.compilation_group) = + LIST.foldmap (cg, acc) ~f:(fm_compilation_unit funs) + + (** This record contains the functions with the default behaviour of the mapfolder (do nothing) except + for the picture where it applies the transformation provided by {!Annot_map.picture_repr}. *) + let fm_default: 'a fm_funs = { + compilation_group; + compilation_unit; + program_definition; + program_prototype; + function_definition; + function_prototype; + data_sec_traversal_funs = Data_sec_traversal.fm_default; + data_div_traversal_funs = Data_div_traversal.fm_default; + } + + +end + +module Id_default_mapper = struct + let picture = Fun.id + let file_section = Fun.id + let working_storage_section = Fun.id + let linkage_section = Fun.id + let communication_section = Fun.id + let local_storage_section = Fun.id + let report_section = Fun.id + let screen_section = Fun.id +end + +module MakeId (Ast: Ast.S) = Make (Ast) (Ast) (Id_default_mapper) +*) diff --git a/src/interop-js-stubs/version.mlt b/src/lsp/cobol_ast/version.mlt similarity index 100% rename from src/interop-js-stubs/version.mlt rename to src/lsp/cobol_ast/version.mlt diff --git a/src/lsp/cobol_common/README.md b/src/lsp/cobol_common/README.md new file mode 100644 index 000000000..7d525e3f6 --- /dev/null +++ b/src/lsp/cobol_common/README.md @@ -0,0 +1,10 @@ +# Cobol_common package + +This package contains utility modules that are used in all other `superbol` libraries. +The main modules found here are: +* `Basics` which contains basic helper modules such as `StringMap`, `StringSet` and functions for pairs and lists +* `Srcloc` which contains all functions to handle source locations +* `Diagnostics` to handle the creation and printing of diagnostics +* `Visitors` which contains all the basic defitions for our visitors + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_common/basics.ml b/src/lsp/cobol_common/basics.ml new file mode 100644 index 000000000..2956fa5ce --- /dev/null +++ b/src/lsp/cobol_common/basics.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open EzCompat (* for StringMap and Stringset *) + +(* CHECKE: Is it worth having this long name in addition to StrMap *) +module StringMap = StringMap +module StringSet = StringSet +module Strings = StringSet (** alias of {!StringSet} *) +module StrMap = StringMap (** alias of {!StringMap} *) +module IntMap = Map.Make (Int) +module CharSet = Set.Make (Char) + +module Pair = struct + + let with_fst l r = (l, r) + let with_snd r l = (l, r) + + let map_fst ~f (l, r) = (f l, r) + let map_snd ~f (l, r) = (l, f r) + + (** [filter_fst (Some l, r) = Some (l, r) ] and [filter_fst (None, _) = None] *) + let if_fst (l, r) = Option.map (fun l -> l, r) l + + (** [filter_snd (l, Some r) = Some (l, r)] and [filter_snd (_, None) = None] *) + let if_snd (l, r) = Option.map (fun r -> l, r) r + + let filter = function + | Some l, Some r -> Some (l, r) + | _ -> None + + let filter_map_fst ~f (l, r) = Option.map (fun l -> f l, r) l + + let filter_snd_map_pair ~f (l, r) = Option.map (fun r -> f (l, r) ) r + + let filter_map_snd ~f (l, r) = Option.map (fun r -> l, f r) r + + let filter_map ~fl ~fr = function + | Some l, Some r -> Some (fl l, fr r) + | _ -> None + + let swap (f, s) = (s, f) +end + +(* Fabrice: we should upstream such functions in ocplib-stuff, within + the EzList module *) +module LIST = struct + (** [split_at_first ~prefix ~where p list] splits [list] right after, right + before, or around the first element [e] that satisfies [p e]. + + [prefix] indicates whether or not to keep the prefix in revered order, and + [where] instructs where to split ([`Around] discards the element). *) + let split_at_first + ~(prefix: [`Same | `Rev]) + ~(where: [`After | `Before | `Around]) + p + = + let prefix = match prefix with + | `Same -> List.rev + | `Rev -> fun l -> l + in + let rec aux acc l = match l, where with + | [], _ -> Error () + | x :: tl, _ when not (p x) -> aux (x :: acc) tl + | x :: tl, `After -> Ok (prefix (x :: acc), tl) + | x :: tl, `Before -> Ok (prefix acc, x :: tl) + | _ :: tl, `Around -> Ok (prefix acc, tl) + in + aux [] + + (** [take_while pred l] returns all the successive elements of [l] while [pred elt] is + is satisfied, [elt] being the first element of the remaining of the list. *) + let take_while pred list = + let rec aux acc l = + match l with + | hd::tl when pred hd -> + aux (hd::acc) tl + | _ -> + List.rev acc + in + aux [] list + + (*TODO: Remove this and edit its occurences with List.fold_left_map *) + let foldmap ~f (l, acc) = + let l, acc = List.fold_left + (fun (l, acc) x -> let x, acc = f acc x in x::l, acc) ([], acc) l + in + List.rev l, acc + + + (** [fold_left_while pred f acc l] is (f (... (f acc l1) ...) ln) with [l1] [ln] the elements of + [l] for which [pred acc] is satisfied. *) + let rec fold_left_while pred f acc l = + match l with + | [] -> acc + | hd::tl when pred acc -> fold_left_while pred f (f acc hd) tl + | _ -> acc + + (** [fold_left_whilei pred f acc l] is (f n (... (f 0 acc l0) ...) ln) with [l0] [ln] the elements of + [l] for which [pred acc] is satisfied. *) + let fold_left_whilei pred f acc l = + let rec aux idx pred f acc l = + match l with + | [] -> acc + | hd::tl when pred acc -> aux (idx + 1) pred f (f idx acc hd) tl + | _ -> acc + in + aux 0 pred f acc l +end + +(** This operator maps a ['a option * 'b] to the function [f]. The function [f] must be of type + ['b -> 'a -> 'c * 'b]. [(x, acc) >>= f] returns [None, acc] if [x = None] or [(Some x', acc')] + if [x = Some y] with [x', acc' = f acc y]. *) +let (>>=) (x, acc) f = + Option.fold ~none:(None, acc) ~some:(fun x -> let x, acc = f acc x in Some x, acc) x + + +(*CHECKME: Is there an already defined operator for this? If not maybe we can keep these + * somewhere else, it might be useful in more than one places, or maybe it's too confusing. *) +let (>>) f g = (fun x -> f x |> g) diff --git a/src/lsp/cobol_common/behaviors.ml b/src/lsp/cobol_common/behaviors.ml new file mode 100644 index 000000000..3a0329b97 --- /dev/null +++ b/src/lsp/cobol_common/behaviors.ml @@ -0,0 +1,21 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Type tags, useful to name and determine component behaviors *) +(* This may not really belong to `Cobol_common` as it's not specific to COBOL. + Still, only `Srcloc` really satisfies that property; we should probably end + up with an `Cobol_srcloc` library, and rename `Cobol_common` into something + like `Superbol_utils`. *) + +type amnesic = ForgetAll +type eidetic = RememberAll diff --git a/src/lsp/cobol_common/cobol_common.ml b/src/lsp/cobol_common/cobol_common.ml new file mode 100644 index 000000000..b46148254 --- /dev/null +++ b/src/lsp/cobol_common/cobol_common.ml @@ -0,0 +1,143 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Basics = Basics +module Srcloc = Srcloc +module Diagnostics = Diagnostics +module Visitor = Visitor +module Behaviors = Behaviors +module Tokenizing = Tokenizing + +exception FatalError of string +let fatal fmt = Pretty.string_to (fun s -> raise @@ FatalError s) fmt + +let status_ref = ref 0 +let exit ?(status= 0) () = + exit (max status !status_ref) + +(* Register a printer for some common exceptions. *) +let () = + Printexc.register_printer begin function + | Failure m + | Sys_error m + | Stdlib.Arg.Bad m -> Some m + | _ -> None + end + +(* --- *) + +module Types = struct + + (** Transitional (to be removed) *) + type 'a res = ('a * Diagnostics.Set.t, Diagnostics.Set.t) result + + include Diagnostics.TYPES + include Srcloc.TYPES + +end +include Types + +(* TODO: move the ['a result] type related functions somewhere else *) +let join_all l = + List.fold_left + (fun res elt -> + match res, elt with + | Result.Error e, _ | _, Result.Error e -> Error e + | Ok res, Ok e -> Ok (e::res)) + (Ok []) + l + |> Result.map List.rev + +let join_any l = + List.filter_map + (fun elt -> + match elt with + | Ok elt -> + Some elt + | Error _ -> + None) + l + |> List.rev + +let catch_diagnostics ?(ppf = Fmt.stderr) f x = + let module D = Diagnostics.InitStateful () in + match f (module D: Diagnostics.STATEFUL) x with + | Ok (v, diags) -> + Ok (v, Diagnostics.Set.union diags @@ D.inspect ~reset:true) + | Error diags -> + Error (Diagnostics.Set.union diags @@ D.inspect ~reset:true) + | exception Msgs.LocalizedError (s, loc, _) -> (* TODO: addenda *) + D.error ~loc "%t" s; + Error (D.inspect ~reset:true) + | exception Msgs.Error msg -> + D.error "%t" msg; + Error (D.inspect ~reset:true) + (* | exception (Failure msg | Sys_error msg) -> *) + (* D.error "%s" msg; *) + (* Error (D.inspect ~reset:true) *) + (* | exception Diagnostics.Fatal.Sink diags -> *) + (* Error (Diagnostics.Set.union diags @@ D.inspect ~reset:true) *) + | exception (FatalError _ as e) -> + Pretty.print ppf "%a%!" Diagnostics.Set.pp (D.inspect ~reset:false); + raise e + +let with_stateful_diagnostics ~f x = + let module D = Diagnostics.InitStateful () in + let result = f (module D: Diagnostics.STATEFUL) x in + { result; diags = D.inspect ~reset:true } + +(** [show_diagnostics ~ppf diagnostics] prints the given set of diagnostics + using the formatter [ppf] (that defaults to [stderr]), and sets an internal + status flags to register whether [diagnostics] includes an error. This flag + is used to determine the status code upon program termination. *) +let show_diagnostics ?(ppf = Fmt.stderr) diags = + Pretty.print ppf "%a%!" Diagnostics.Set.pp diags; + if Diagnostics.Set.has_errors diags then status_ref := !status_ref lor 1 + +let catch_n_show_diagnostics ~cont ?(ppf = Fmt.stderr) f x = + match catch_diagnostics ~ppf f x with + | Ok (_, diags) | Error diags as res -> + show_diagnostics ~ppf diags; + if Result.is_error res then status_ref := !status_ref lor 1; + cont res + +(* --- *) + +let do_one ~cont f ?epf a = + catch_n_show_diagnostics ?ppf:epf ~cont f a + +let do_unit f = + do_one begin fun diags a -> + f diags a; + Ok ((), Diagnostics.Set.none) + end ~cont:(fun _ -> ()) + +let do_any f = + do_one begin fun diags a -> + Ok (f diags a, Diagnostics.Set.none) + end ~cont:(Result.fold ~ok:fst ~error:(fun _ -> Stdlib.exit 1)) + +(* --- *) + +(* let tmp_files = ref [] *) +(* let remove_temporary_files = ref true *) + +(* let add_temporary_file file = tmp_files := file :: !tmp_files *) +(* let keep_temporary_files () = remove_temporary_files := false *) + +(* ;; *) + +(* at_exit begin fun () -> *) +(* if !remove_temporary_files then *) +(* List.iter (fun file -> Sys.remove file) !tmp_files *) +(* end *) diff --git a/src/lsp/cobol_common/cobol_common.mli b/src/lsp/cobol_common/cobol_common.mli new file mode 100644 index 000000000..a3a84d3b7 --- /dev/null +++ b/src/lsp/cobol_common/cobol_common.mli @@ -0,0 +1,95 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Basics = Basics +module Srcloc = Srcloc +module Diagnostics = Diagnostics +module Visitor = Visitor +module Behaviors = Behaviors +module Tokenizing = Tokenizing + +exception FatalError of string +val fatal: ('a, Format.formatter, unit, _) format4 -> 'a + +module Types: sig + + (** Transitional (to be removed) *) + type 'a res = ('a * Diagnostics.Set.t, Diagnostics.Set.t) result + + include module type of Diagnostics.TYPES + include module type of Srcloc.TYPES + +end +include module type of Types + with type 'a res = 'a Types.res + and type 'a with_diags = 'a Types.with_diags + and type 'a with_loc = 'a Types.with_loc + and type lexloc = Types.lexloc + and type srcloc = Types.srcloc + +(** [join_all diags res_l] takes every value of a list of {!type:('a, 'e) result} + and return a {!type:('a, 'e) list result}. If all the elements in the parameter list + are [Ok _] then the result is [Ok _] otherwise [Error _] *) +val join_all: ('a, 'e) result list -> ('a list, 'e) result + +(** [join_any diags res_l] takes a list of result and makes it a list, the elements of the given + list are added to the resulting list only if they are [Ok _]. *) +val join_any: ('a, 'e) result list -> 'a list + +(** [catch_diagnostics ?ppf f x] enables [f] to fail abruptly with an exception + while operating on an imperative (state-full) diagnostics module. + + It first creates a stateful diagnostics module [D] and calls [f D x] while + intercepting common system exceptions (only {!Sys_error} for now) and fatal + diagnostics. An {!Error} is returned in the latter case, or whenever [f] + terminates with an {!Error}. + + At last, the diagnostics accumulated in [D] are printed using [ppf] + ([Format.err_formatter] by default) in case of a fatal error ({!fatal} is + called and {!FatalError} is not caught --- which it shouldn't); in this case + {!FatalError} is re-thrown afterwards. *) +val catch_diagnostics + : ?ppf:Format.formatter + -> ((module Diagnostics.STATEFUL) -> 'c -> 'a res) -> 'c -> 'a res + +(** [with_stateful_diagnostics ~f x] applies [f] on a fresh stateful diagnostics + module [D] and [x], and returns the result combined with all diagnostics + accumulated using [D]. + + Any exception that may be raised and escape [f] is not caught, so it is the + responsibility of [f] to catch it. *) +val with_stateful_diagnostics + : f:((module Diagnostics.STATEFUL) -> 'b -> 'a) -> 'b -> 'a with_diags + +val show_diagnostics + : ?ppf:Format.formatter + -> Diagnostics.Set.t -> unit + + +(** Exit the program with a status that depends on diagnostics reported in + {!catch_n_show_diagnostics}. *) +val exit: ?status:int -> unit -> _ + + + +val do_unit + : ((module Diagnostics.STATEFUL) -> 'a -> unit) + -> ?epf:Format.formatter + -> 'a + -> unit + +val do_any + : ((module Diagnostics.STATEFUL) -> 'a -> 'b) + -> ?epf:Format.formatter + -> 'a + -> 'b diff --git a/src/lsp/cobol_common/diagnostics.ml b/src/lsp/cobol_common/diagnostics.ml new file mode 100644 index 000000000..50dc7f212 --- /dev/null +++ b/src/lsp/cobol_common/diagnostics.ml @@ -0,0 +1,269 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Srcloc + +module TYPES = struct + type severity = Diagnostics_sigs.severity = + | Hint (** hint *) + | Note (** general note *) + | Info (** informative message *) + | Warn (** warning *) + | Error (** unrecoverable error *) + + type diagnostic = + { + severity: severity; + message: Pretty.delayed; + location: srcloc option; + stamp: int; + } + + type diagnostics = diagnostic list (* reversed, abstract *) + + type 'a in_result = ('a * diagnostic option, diagnostic option) result + + type 'a with_diags = + { + result: 'a; + diags: diagnostics; + } +end +include TYPES +type t = diagnostic + +let mk = + let current_stamp = ref 0 in + fun severity location message -> + let stamp = !current_stamp in + incr current_stamp; + { severity; message; location; stamp } + +let pp ppf { severity; message; location = loc; _ } = + let prefix, style = match severity with + | Hint -> "Hint", `Fg `Cyan + | Note -> "Note", `None + | Info -> "Info", `Fg `Green + | Warn -> "Warning", `Fg `Yellow + | Error -> "Error", `Fg `Red + in + Msgs.pp_msg ?loc ppf "%a" begin + Pretty.styles [`Bold; style] @@ fun ppf -> + Pretty.print ppf ">> %s: @[%t@]@\n" prefix + end message + +let is_error = function + | { severity = Error; _ } -> true + | _ -> false + +let pp_msg ppf diag = diag.message ppf +let message diag = diag.message +let severity diag = diag.severity +let location diag = diag.location + +(* --- *) + +module One = struct + (** Reporting module where each function builds and returns a single + diagnostic. *) + let diag severity ?loc = Pretty.delayed_to (mk severity loc) + let hint ?loc fmt = diag Hint ?loc fmt + and note ?loc fmt = diag Note ?loc fmt + and info ?loc fmt = diag Info ?loc fmt + and warn ?loc fmt = diag Warn ?loc fmt + and error ?loc fmt = diag Error ?loc fmt + and blind = Fun.id +end + +module Now = struct + (** Reporting module where each value is a procedure that prints a single + diagnostic on a given formatter. *) + let diag severity ppf ?loc fmt = + Pretty.delayed_to (fun message -> pp ppf (mk severity loc message)) (fmt^^"@.") + let hint ppf = diag Hint ppf + and note ppf = diag Note ppf + and info ppf = diag Info ppf + and warn ppf = diag Warn ppf + and error ppf = diag Error ppf + and blind = pp +end + +module Cont = struct + (** Reporting module where each function gives diagnostics to a continuation + function. *) + let kdiag severity k ?loc = + Pretty.delayed_to (fun message -> k (mk severity loc message)) + let khint s = kdiag Hint s + and knote s = kdiag Note s + and kinfo s = kdiag Info s + and kwarn s = kdiag Warn s + and kerror s = kdiag Error s + and kblind = ( @@ ) +end + +(* --- *) + +module Set = struct + (** Persistent sets of diagnostics *) + + type t = diagnostics (* reversed *) + + let sort diags = + List.sort (fun { stamp = s1; _ } { stamp = s2; _ } -> Int.compare s1 s2) diags + + (* TODO: order via locs and/or a global timestamp? something more + intricate? *) + let pp ppf diags = + Pretty.list ~fopen:"@[" ~fclose:"@]@\n" ~fsep:"@\n" ~fempty:"" + pp ppf (sort diags) + let none: t = [] + let one d = [d] + let two d d' = [d; d'] + let maybe = Option.fold ~some:one ~none + let cons = List.cons + let union = List.rev_append + let has_errors = List.exists is_error + let map f diags = List.map f (sort diags) + let fold f diags acc = List.fold_left (fun a d -> f d a) acc (sort diags) + + let diag s = Cont.kdiag s one + let hint ?loc = Cont.khint one ?loc + let note ?loc = Cont.knote one ?loc + let info ?loc = Cont.kinfo one ?loc + let warn ?loc = Cont.kwarn one ?loc + let error ?loc = Cont.kerror one ?loc + let blind = Cont.kblind one + + (** Sets of diagnostics with values that do not contain any closure or module, + and that can thus be marshalled/unmarshalled safely. + + The ability to perform delayed formatting is lost when translating from + "regular" diagnostics into serializable ones, as the translation applies + the formatting as if into a string without any right-margin. *) + type serializable = serializable_diagnostic list + and serializable_diagnostic = { + sd_severity: severity; + sd_msg: string; + sd_loc: srcloc option; + } + + let apply_delayed_formatting: t -> serializable = + map begin fun { severity; message; location; _ } -> + { sd_severity = severity; + sd_msg = Pretty.(to_string "%t@[%t@]" blast_margin) message; + sd_loc = location } + end + let of_serializable: serializable -> t = + List.map begin fun { sd_severity; sd_msg; sd_loc } -> + mk sd_severity sd_loc (Pretty.delayed "%s" sd_msg) + end +end +type diagnostics = Set.t + +(* --- *) + +module Acc = struct + (** Reporting module where each functions adds diagnostics into a given + set. *) + let diag severity (diags: diagnostics) ?loc = + Pretty.delayed_to (fun message -> Set.cons (mk severity loc message) diags) + let hint s = diag Hint s + and note s = diag Note s + and info s = diag Info s + and warn s = diag Warn s + and error s = diag Error s + and blind s d = Set.cons d s +end + +include Acc +include Cont + +(* --- *) + +let result ?(diags = Set.none) result = { result; diags } +let with_diag r d = result ~diags:(Set.one d) r +let with_diags r diags = result ~diags r +let with_more_diags ~diags { result; diags = diags' } = + { result; diags = Set.union diags' diags } +let simple_result r = result r +let some_result ?diags r = result ?diags (Some r) +let no_result ~diags = { result = None; diags } +let map_result f { result; diags } = { result = f result; diags } + +let hint_result r = Cont.khint (with_diag r) +let note_result r = Cont.knote (with_diag r) +let info_result r = Cont.kinfo (with_diag r) +let warn_result r = Cont.kwarn (with_diag r) +let error_result r = Cont.kerror (with_diag r) + +(* --- *) + +(** Type of modules that encapsulate an internal, mutable, set of diagnostics. + See {!Cobol_common.catch_diagnostics} and + {!Cobol_common.catch_n_show_diagnostics} for typical usage. *) +module type STATEFUL = Diagnostics_sigs.STATEFUL + with type blind := t -> unit + and type diagnostics := diagnostics + and type 'a with_diags := 'a with_diags + +module type STATEFUL0 = Diagnostics_sigs.STATEFUL0 + with type blind := t -> unit + and type diagnostics := diagnostics + and type 'a with_diags := 'a with_diags + +(** Initializes a stateful diagnostics reporting module based on the given + history. *) +module MakeStateful (H: sig val history: diagnostics end) = struct + let diags = ref H.history + let blind d = diags := d :: !diags + let add_all set = diags := List.rev_append set !diags + let inspect ~reset = + let res = !diags in + if reset then diags := []; + res + let diag severity ?loc = + Pretty.delayed_to (fun message -> blind (mk severity loc message)) + let hint ?loc = diag Hint ?loc + and note ?loc = diag Note ?loc + and info ?loc = diag Info ?loc + and warn ?loc = diag Warn ?loc + and error ?loc = diag Error ?loc + let grab_diags { result; diags } = add_all diags; result +end + +(** Initializes a stateful diagnostics reporting module based on an empty + history. *) +module InitStateful () = MakeStateful (struct let history = Set.none end) + +(* --- *) + +module Fatal = struct + (** Fatal errors from which we cannot recover. *) + let localized_error = Msgs.localized_error + let error = Msgs.error + (* exception Sink of Set.t *) + + (* (\** Fail with a set of diagnostics *\) *) + (* let sink s = raise @@ Sink s *) +end + +let of_exn: exn -> diagnostic = function + | Msgs.LocalizedError (s, loc, _) -> (* TODO: addenda *) + One.error ~loc "%t" s + | Msgs.Error msg -> + One.error "%t" msg + | Failure msg + | Sys_error msg -> + One.error "%s" msg + | e -> + raise e diff --git a/src/lsp/cobol_common/diagnostics.mli b/src/lsp/cobol_common/diagnostics.mli new file mode 100644 index 000000000..cd1eac3f7 --- /dev/null +++ b/src/lsp/cobol_common/diagnostics.mli @@ -0,0 +1,148 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module TYPES: sig + type severity = Diagnostics_sigs.severity = + | Hint + | Note + | Info + | Warn + | Error + + type diagnostic + type diagnostics + + type 'a in_result = ('a * diagnostic option, diagnostic option) result + + type 'a with_diags = + { + result: 'a; + diags: diagnostics; + } +end +include module type of TYPES + with type severity = TYPES.severity + and type diagnostic = TYPES.diagnostic + and type diagnostics = TYPES.diagnostics + and type 'a in_result = 'a TYPES.in_result + and type 'a with_diags = 'a TYPES.with_diags +type t = diagnostic + +val pp: t Pretty.printer +val pp_msg: t Pretty.printer + +val message: t -> Pretty.delayed +val severity: t -> severity +val location: t -> Srcloc.srcloc option + +(** {1 Set of diagnostics} *) + +module Set: sig + (** Persistent set of diagnostics *) + type t = diagnostics + val pp: t Pretty.printer + val none: t + val one: diagnostic -> t + val maybe: diagnostic option -> t + val two: diagnostic -> diagnostic -> t + val cons: diagnostic -> t -> t + val union: t -> t -> t + val has_errors: t -> bool + val map: (diagnostic -> 'a) -> t -> 'a list + val fold: (diagnostic -> 'a -> 'a) -> t -> 'a -> 'a + + include Diagnostics_sigs.REPORT + with type 'a t := ?loc:Srcloc.srcloc -> ('a, t) Pretty.func + and type blind := diagnostic -> t + + (** Sets of diagnostics with values that do not contain any closure or module, + and that can thus be marshalled/unmarshalled safely. + + The ability to perform delayed formatting is lost when translating from + "regular" diagnostics into serializable ones, as the translation applies + the formatting as if into a string without any right-margin. *) + type serializable + val apply_delayed_formatting: t -> serializable + val of_serializable: serializable -> t +end + +(** {1 Functional and imperative interfaces to diagnostics} *) + +module One: Diagnostics_sigs.REPORT + with type 'a t := ?loc:Srcloc.srcloc -> ('a, t) Pretty.func + and type blind := t -> t + +module Now: Diagnostics_sigs.REPORT + with type 'a t := Format.formatter -> ?loc:Srcloc.srcloc -> 'a Pretty.proc + and type blind := Format.formatter -> t -> unit + +module Acc: Diagnostics_sigs.REPORT + with type 'a t := (Set.t as 's) -> ?loc:Srcloc.srcloc -> ('a, 's) Pretty.func + and type blind := Set.t -> t -> Set.t + +module Cont: Diagnostics_sigs.KREPORT + with type ('a, 'b) t := (t -> 'b) -> ?loc:Srcloc.srcloc -> ('a, 'b) Pretty.func + and type 'b kblind := (t -> 'b) -> t -> 'b + +(** Allow direct access to persistent diagnostics reporting *) +include module type of Acc +include module type of Cont + +(* --- *) + +val result: ?diags:diagnostics -> 'a -> 'a with_diags +val with_diag: 'a -> diagnostic -> 'a with_diags +val with_diags: 'a -> diagnostics -> 'a with_diags +val with_more_diags: diags:diagnostics -> 'a with_diags -> 'a with_diags +val simple_result: 'a -> 'a with_diags +val some_result: ?diags:diagnostics -> 'a -> 'a option with_diags +val no_result: diags:diagnostics -> _ option with_diags +val map_result: ('a -> 'b) -> 'a with_diags -> 'b with_diags + +val hint_result: 'a -> ?loc:Srcloc.srcloc -> ('b, 'a with_diags) Pretty.func +val note_result: 'a -> ?loc:Srcloc.srcloc -> ('b, 'a with_diags) Pretty.func +val info_result: 'a -> ?loc:Srcloc.srcloc -> ('b, 'a with_diags) Pretty.func +val warn_result: 'a -> ?loc:Srcloc.srcloc -> ('b, 'a with_diags) Pretty.func +val error_result: 'a -> ?loc:Srcloc.srcloc -> ('b, 'a with_diags) Pretty.func + +(* --- *) + +module type STATEFUL = Diagnostics_sigs.STATEFUL + with type blind := t -> unit + and type diagnostics := diagnostics + and type 'a with_diags := 'a with_diags + +module type STATEFUL0 = Diagnostics_sigs.STATEFUL0 + with type blind := t -> unit + and type diagnostics := diagnostics + and type 'a with_diags := 'a with_diags + +module MakeStateful: + functor (H: sig val history: diagnostics end) -> STATEFUL0 + +module InitStateful: + functor () -> STATEFUL0 + +(* --- *) + +module Fatal: Diagnostics_sigs.FATAL + with type ('a, 'b) with_location := + ?addenda:Msgs.addenda + -> Srcloc.srcloc + -> ('a, Format.formatter, unit, 'b) format4 -> 'a + and type ('a, 'b) with_optional_location := + ?loc:(Srcloc.srcloc) + -> ('a, Format.formatter, unit, 'b) format4 -> 'a + (* and type set := Set.t *) + +val of_exn: exn -> diagnostic diff --git a/src/lsp/cobol_common/diagnostics_sigs.ml b/src/lsp/cobol_common/diagnostics_sigs.ml new file mode 100644 index 000000000..b31faa4c1 --- /dev/null +++ b/src/lsp/cobol_common/diagnostics_sigs.ml @@ -0,0 +1,70 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Modules signatures dedicated to diagnostics. + + Placed here to avoid duplications in ML & MLI *) + +type severity = + | Hint + | Note + | Info + | Warn + | Error + +module type REPORT = sig + type _ t and blind + val diag: severity -> _ t + val hint: _ t + val note: _ t + val info: _ t + val warn: _ t + val error: _ t + val blind: blind +end + +module type KREPORT = sig + type (_, _) t and 'a kblind + val kdiag: severity -> _ t + val khint: _ t + val knote: _ t + val kinfo: _ t + val kwarn: _ t + val kerror: _ t + val kblind: 'a kblind +end + +module type STATEFUL = sig + include REPORT + with type 'a t := ?loc:Srcloc.srcloc -> 'a Pretty.proc + type diagnostics + type _ with_diags + val add_all: diagnostics -> unit + val grab_diags: 'a with_diags -> 'a +end + +module type STATEFUL0 = sig + include STATEFUL + val inspect: reset:bool -> diagnostics +end + +module type FATAL = sig + type ('a, 'b) with_location + type ('a, 'b) with_optional_location + val localized_error: _ with_location [@@deprecated "Please try a proper \ + recovery"] + val error: _ with_optional_location + (* type set *) + (* exception Sink of set *) + (* val sink: set -> _ *) +end diff --git a/src/lsp/cobol_common/dune b/src/lsp/cobol_common/dune new file mode 100644 index 000000000..501f2f807 --- /dev/null +++ b/src/lsp/cobol_common/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_common) + (public_name cobol_common) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries pretty ppx_deriving str) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show ppx_deriving.ord)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_common)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_common/index.mld b/src/lsp/cobol_common/index.mld new file mode 100644 index 000000000..24baee349 --- /dev/null +++ b/src/lsp/cobol_common/index.mld @@ -0,0 +1,16 @@ +{1 Library cobol_common} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This library contains utility modules that are used in all other {b Superbol} packages: +{ul + {- {!Cobol_common.Basics} contains basic helper modules such as [StringMap], [StringSet] and + helper functions for pairs and lists.} + {- {!Cobol_common.Diagnostics} which contains all the logic to create and print diagnostics.} + {- {!Cobol_common.Srcloc} which contains all the logic to handle locations.} + {- {!Cobol_common.Visitors} which contains all the basic definitions for our visitors.}} + + +The entry point of this library is the module: {!Cobol_common}. + diff --git a/src/lsp/cobol_common/msgs.ml b/src/lsp/cobol_common/msgs.ml new file mode 100644 index 000000000..862dc060e --- /dev/null +++ b/src/lsp/cobol_common/msgs.ml @@ -0,0 +1,52 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +type addenda = (Pretty.delayed * Srcloc.srcloc option) list +exception LocalizedError of Pretty.delayed * Srcloc.srcloc * addenda +exception Error of Pretty.delayed + +let localized_error ?(addenda = []) (loc: Srcloc.srcloc) = + Pretty.delayed_to (fun s -> raise @@ LocalizedError (s, loc, addenda)) + +let error ?loc = + Pretty.delayed_to (fun s -> match loc with + | None -> raise @@ Error s + | Some loc -> raise @@ LocalizedError (s, loc, [])) + +(* --- *) + +let pp_msg ?loc ppf fmt = + (* Source text right above message for now: *) + Pretty.print ppf ("%a"^^fmt) (Pretty.option Srcloc.pp_srcloc) loc + +(* --- *) + +let pp_kuncaught k exn fmt = + Pretty.string_to k ("Fatal error: uncaught exception %s:@\n"^^fmt) exn + +(* Register some printing functions, useful upon misuse of + `Cobol_common.catch_diagnostics` and co. *);; +Stdlib.Printexc.register_printer begin + let uncaught exn fmt = + pp_kuncaught Option.some (__MODULE__^exn) @@ fmt ^^ + "@\n(Dev hint: this is probably due to a missing call to \ + Cobol_common.catch_diagnostics)@." + in + function + | LocalizedError (msg, loc, _) -> + uncaught "LocalizedError" "%a" (fun ppf -> pp_msg ~loc ppf "%t") msg + | Error msg -> + uncaught "Error" "%t" msg + | _ -> + None +end diff --git a/src/lsp/cobol_common/package.toml b/src/lsp/cobol_common/package.toml new file mode 100644 index 000000000..5b379041d --- /dev/null +++ b/src/lsp/cobol_common/package.toml @@ -0,0 +1,75 @@ + +# name of package +name = "cobol_common" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +generators = ["menhir"] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show ppx_deriving.ord" + +# files to skip while updating at package level +skip = ["main.ml", "index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +ppx_deriving = ">=5.2.1" +pretty = "version" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +dune-libraries = "str" diff --git a/src/lsp/cobol_common/srcloc.ml b/src/lsp/cobol_common/srcloc.ml new file mode 100644 index 000000000..91c1c3946 --- /dev/null +++ b/src/lsp/cobol_common/srcloc.ml @@ -0,0 +1,652 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file.V1 + +module TYPES = struct + + (* Tags used to refine the representation of source locations below. *) + type raw_ = [ `Raw ] + type cpy_ = [ `Cpy ] + type rpl_ = [ `Rpl ] + type cat_ = [ `Cat ] + + (** A location is any composition of simple lexing positions, *) + type srcloc = any_ slt + + and any_ = [raw_|cpy_|rpl_|cat_] + + (* represented using a source location tree. *) + and _ slt = + | Raw: raw -> [>raw_] slt + | Cpy: { copied: any_ slt; copyloc: copyloc } -> [>cpy_] slt + | Rpl: replacement -> [>rpl_] slt + | Cat: { left: left_ slt; right: right_ slt } -> [>cat_] slt + (* invariant: Cat {left = Cpy _ ; right = Cpy _}: the two copies are not + from the same file. *) + + (* Raw lexical range *) + and lexloc = Lexing.position * Lexing.position + and raw = Lexing.position * Lexing.position * bool (* area-a flag *) + + (* Representation of a file copy operation *) + and copyloc = { filename: string; copyloc: srcloc (* option *) } + + and replacement = + { + old: any_ slt; (* should only keep ref. of starting pos if needed for + area-a detection... *) + new_: srcloc; (* location of replacement spec (e.g, pseudotext) *) + in_area_a: bool; + replloc: srcloc; + } + + (* A (con)cat(enation) allows any sort of source location on its left... *) + and left_ = any_ + + (* ... but forbids other cats directly on its right. *) + and right_ = [raw_|cpy_|rpl_] + + (** Values attached with a source location. *) + type 'a with_loc = { payload: 'a; loc: srcloc [@compare fun _ _ -> 0] } + [@@ deriving ord] + +end +include TYPES + +(* For debugging: *) + +let pp_srcloc_struct: srcloc Pretty.printer = + let pp_lexloc ppf Lexing.{ pos_fname; pos_lnum; pos_cnum; pos_bol } = + Pretty.print ppf "%s:%d-%d" pos_fname pos_lnum (pos_cnum - pos_bol) + and pp_lexloc' ppf Lexing.{ pos_lnum; pos_cnum; pos_bol; _ } = + Pretty.print ppf "%d-%d" pos_lnum (pos_cnum - pos_bol) + in + let rec pp: type t. t slt Pretty.printer = fun ppf -> function + | Raw (s, e, _) -> + Pretty.print ppf "<%a|%a>" + pp_lexloc s pp_lexloc' e + | Cpy { copied; _ } -> + Pretty.print ppf "Cpy { copied = %a }" + pp copied + | Rpl { old; new_; replloc; _ } -> + Pretty.print ppf "Rpl { @[matched = %a;\ + @ replacement = %a;\ + @ replloc = %a@] }" + pp old pp new_ pp replloc + | Cat { left; right } -> + Pretty.print ppf "Cat { @[left = %a;@ right = %a@] }" + pp left pp right + in + pp + +(** {2 Manipulating source locations} *) + +(** copied, but original (replaced) position upon replacing *) +let rec start_pos: type t. t slt -> Lexing.position = function + | Raw (s, _, _) -> s + | Cpy { copied; _ } -> start_pos copied + | Rpl { old; _ } -> start_pos old + | Cat { left; _ } -> start_pos left + +let start_pos_in ~filename = + let rec aux: type t. t slt -> Lexing.position option = function + | Raw (s, _, _) when s.pos_fname = filename -> Some s + | Raw _ -> None + | Cat { left; right } -> or_else left right + | Cpy { copied; copyloc = { copyloc; _ } } -> or_else copied copyloc + | Rpl { new_; old; replloc; _ } -> + match aux new_ with None -> or_else old replloc | res -> res + and or_else: type t u. t slt -> u slt -> _ = fun a b -> + match aux a with None -> aux b | res -> res + in + aux + +let end_pos_in ~filename = + let rec aux: type t. t slt -> Lexing.position option = function + | Raw (_, e, _) when e.pos_fname = filename -> Some e + | Raw _ -> None + | Cat { left; right } -> or_else right left + | Cpy { copied; copyloc = { copyloc; _ } } -> or_else copied copyloc + | Rpl { new_; old; replloc; _ } -> + match aux new_ with None -> or_else old replloc | res -> res + and or_else: type t u. t slt -> u slt -> _ = fun a b -> + match aux a with None -> aux b | res -> res + in + aux + +(** [forget_preproc ~favor_direction ~traverse_copies ~traverse_replaces loc] + eliminates any preprocessing operation from the source location [loc], and + returns a valid lexical range in {b a} file that participated in its + construction. + + - [favor_direction] indicates whether to favor searching for the range from + the left or the right bound of the location; + + - if [traverse_copies] is false, the location of {[COPY ...]} preprocessor + statemenents is considered as a whole and not decomposed. If + [traverse_copies] holds, returned ranges may belong to copybooks; + + - if [traverse_replaces] is false, the location of text that is subject to + replacement is considered as a whole and not decomposed. This can make the + resulting range rather coarse in case of {[REPLACE]} or {[COPY + ... REPLACING]}, as the considered location is then that of the whole text + that participated in a match. On the contrary, the opposite case + ([traverse_replaces] holds) may lead to misleading results (with ranges that + appear in replacement pseudotext). +*) +let forget_preproc + ~(favor_direction: [`Left | `Right]) + ~(traverse_copies: bool) + ~(traverse_replaces: bool) = + let rec aux: type t. t slt -> lexloc = function + | Raw (s, e, _) -> + s, e + | Cpy { copied; copyloc = { copyloc; _ } } -> + aux (if traverse_copies then copied else copyloc) + | Rpl { new_; old; _ } -> + aux (if traverse_replaces then new_ else old) + | Cat { left; right } -> + match favor_direction with + | `Left -> + let (Lexing.{ pos_fname = filename; _ } as s), e = aux left in + s, Option.value (end_pos_in ~filename right) ~default:e + | `Right -> + let s, (Lexing.{ pos_fname = filename; _ } as e) = aux right in + Option.value (start_pos_in ~filename left) ~default:s, e + in + aux + +(** Default projection. This is a shorthand for [forget_preproc + ~favor_direction:`Left ~traverse_copies:true ~traverse_replaces:false]. *) +let as_lexloc: srcloc -> lexloc = + forget_preproc ~favor_direction:`Left + ~traverse_copies:true ~traverse_replaces:false + +let lookup_pos ~lookup ~lookup_name ~filename loc = + match lookup ~filename loc with + | None -> Fmt.invalid_arg "%s.%s: no part of \"%s\" was used to construct the \ + given location (loc = %a)" __MODULE__ lookup_name filename + pp_srcloc_struct loc + | Some s -> s + +let start_pos_in = lookup_pos ~lookup:start_pos_in ~lookup_name:"start_pos_in" +let end_pos_in = lookup_pos ~lookup:end_pos_in ~lookup_name:"end_pos_in" + +(** [lexloc_in ~filename loc] projects the source location [loc] on the file + [filename] by eliminating relevant preprocessor-related locations. + + Raises {!Invalid_argument} in case no valid projection onto the file + [filename] can be found; this never happens if at least one lexical range of + the file [filename] participated in the construction of [loc]. *) +let lexloc_in ~filename loc = + start_pos_in ~filename loc, end_pos_in ~filename loc + +let as_unique_lexloc = function + | Raw (s, e, _) -> Some (s, e) + | _ -> None + +(** [as_copy loc] returns a copybook filename associated with the location of + the {[COPY]} directive if [loc] directly results from such a directive, and + returns [None] otherwise. *) +let as_copy = function + | Cpy { copyloc = { filename; copyloc }; _ } -> + Some { payload = filename; loc = copyloc } + | _ -> (* CHECKME: COPY ... REPLACING ...: Rpl should be nested below Cpy *) + None + +(* --- *) + +(** [in_area_a loc] indicates whether the location [loc] has a left-most raw + location that was built with the [in_area_a] flag. *) +let rec in_area_a: srcloc -> bool = function + | Raw (_, _, a) -> a + | Cpy { copied; _ } -> in_area_a copied + | Rpl { in_area_a; _ } -> in_area_a + | Cat { left; _ } -> in_area_a left + +let scan ?(kind: [`TopDown | `BottomUp] = `TopDown) ~cpy ~rpl = + let rec aux: type t. t slt -> 'a -> 'a = fun loc -> match loc, kind with + | Raw _, _ -> Fun.id + | (Cpy { copied; copyloc } + , `TopDown ) -> fun acc -> acc |> cpy copyloc |> aux copied + | (Cpy { copied; copyloc } + , `BottomUp) -> fun acc -> acc |> aux copied |> cpy copyloc + | (Rpl { old; replloc; _ } + , `TopDown ) -> fun acc -> acc |> rpl replloc |> aux old + | (Rpl { old; replloc; _ } + , `BottomUp) -> fun acc -> acc |> aux old |> rpl replloc + | (Cat { left; right }, _) -> fun acc -> acc |> aux left |> aux right + in + aux + +let fold_lexlocs f loc acc = + let rec aux: type t. t slt -> 'a -> 'a = fun loc -> match loc with + | Raw (s, e, _) -> f (s, e) + | Cpy { copied; _ } -> aux copied + | Rpl { old; _ } -> aux old + | Cat { left; right } -> fun acc -> acc |> aux left |> aux right + in + aux loc acc + +let has_lexloc p loc = + try fold_lexlocs (fun lexloc () -> if p lexloc then raise Exit) loc (); false + with Exit -> true + +let retrieve_file_lines = + let module Cache = + Ephemeron.K1.Make (struct + include String + let hash = Hashtbl.hash + end) + in + let file_cache = lazy (Cache.create 3) in + fun file -> + let file_cache = Lazy.force file_cache in + try Cache.find file_cache file + with Not_found -> + let lines = EzFile.read_lines file in + Cache.add file_cache file lines; + lines + +type raw_loc = string * (int * int) * (int * int) + +let pp_file_loc ppf ((file, pos1, pos2): raw_loc) = + Pretty.print ppf "%s:%a" file Fmt.text_loc (pos1, pos2) + +(** Note this should always end with a newline character *) +let pp_raw_loc: raw_loc Pretty.printer = + let b = lazy (Buffer.create 1000) in + let find_source (file, pos1, pos2) = + let line1 = fst pos1 in + let line2 = fst pos2 in + let col1 = snd pos1 in + let col2 = snd pos2 in + let col2, pad2 = + if line1 == line2 && col1 == col2 then succ col2, 1 else col2, 0 in + let lines = retrieve_file_lines file in + let b = Lazy.force b in + Buffer.clear b; + for l = max 1 (line1 - 3) to min (Array.length lines) (line2 + 2) do + let line = lines.(l - 1) in + let len = String.length line in + Printf.bprintf b "%4d %c %s\n" l + (if l>=line1 && l<=line2 then '>' else ' ') + line; + if l = line1 then + let str = + let len' = len + 1 + if l = line2 then pad2 else 0 in + String.mapi + (if l = line2 + then fun idx c -> if idx > col1 && idx <= col2 then '^' else c + else fun idx c -> if idx > col1 then '^' else c) + (String.make (min len' (col2 + 1)) ' ') + in + Printf.bprintf b "---- %s\n" str; + else if l > line1 && l < line2 then + let str = String.make (len + 1) '^' in + Printf.bprintf b "---- %s\n" str; + else if l = line2 then + let str = + String.mapi + (fun idx c -> if idx <= col2 then '^' else c ) + (String.make (min (len + 1 + pad2) (col2 + 1)) ' ') + in + Printf.bprintf b "---- %s\n" str; + done; + Buffer.contents b + in + fun ppf raw_loc -> + let text = try find_source raw_loc with _ -> "" in + Pretty.print ppf "%a:@\n@[@<0>%s@]" pp_file_loc raw_loc text + +let same_copyloc { filename = f1; _ } { filename = f2; _ } = + f1 = f2 (* berk *) + +let to_raw_loc + Lexing.({ pos_lnum = l1; pos_bol = b1; pos_cnum = c1; pos_fname; _ }, + { pos_lnum = l2; pos_bol = b2; pos_cnum = c2; _ }) = + pos_fname, (l1, c1 - b1), (l2, c2 - b2) + +let pp_srcloc: srcloc Pretty.printer = + let pp_transform_operation ~partial ppf = function + | `Cpy { filename; copyloc } + when partial -> + Pretty.print ppf "%a:@;@[partially@ in@ `%s`,@ copied@ at@ this@ \ + location@]" + pp_file_loc (to_raw_loc @@ as_lexloc copyloc) filename + | `Cpy { copyloc; _ } -> + Pretty.print ppf "%a:@;@[copied@ at@ this@ location@]" + pp_file_loc (to_raw_loc @@ as_lexloc copyloc) + | `Rpl replloc -> + Pretty.print ppf "%a:@;@[subject@ to@ this@ replacement@]" + pp_file_loc (to_raw_loc @@ as_lexloc replloc) + in + let pp_transform_operations ~partial = + Pretty.list ~fopen:"@[<2>" ~fsep:"@]@\n@[" ~fclose:"@]@\n" ~fempty:"" + (pp_transform_operation ~partial) + in + let toplevel_transform_stack loc = + let rec aux acc = function + | Raw _ | Cat _ as loc -> List.rev acc, loc + | Cpy { copied; copyloc } -> aux (`Cpy copyloc :: acc) copied + | Rpl { old; replloc; _ } -> aux (`Rpl replloc :: acc) old + in + aux [] loc + and partial_transform_operations loc = + scan ~kind:`BottomUp loc [] + ~cpy: begin fun copyloc acc -> + (* TODO: use physical equality instead? *) + if List.mem (`Cpy copyloc) acc + then acc + else List.cons (`Cpy copyloc) acc + end + ~rpl: begin fun replloc acc -> + if List.mem (`Rpl replloc) acc + then acc + else List.cons (`Rpl replloc) acc + end + in + fun ppf loc -> + let toplevel_transforms, loc = toplevel_transform_stack loc in + let lexloc = as_lexloc loc in + pp_raw_loc ppf (to_raw_loc lexloc); + pp_transform_operations ~partial:false ppf toplevel_transforms; + pp_transform_operations ~partial:true ppf (partial_transform_operations loc) + +let pp_file_loc ppf loc = + pp_file_loc ppf (to_raw_loc @@ as_lexloc loc) + +(** [raw ~in_area_a lexloc] builds a raw source location from a pair of left- + and right- lexing positions from the same file, optionally setting an + [in_area_a] flag (that defaults to [false]) to indicate whether the location + is the first on its line, and starts in Area A of the source format. *) +let raw ?(in_area_a = false) ((s, e): lexloc) : srcloc = + assert Lexing.(s.pos_cnum <= e.pos_cnum); (* ensure proper use *) + let loc = Raw (s, e, in_area_a) in + if Lexing.(s.pos_fname != e.pos_fname) then + Pretty.error + "%a@\n>> Internal warning in `%s.raw`: file names mismatch (`%s` != `%s`)\ + " pp_srcloc loc __MODULE__ s.pos_fname e.pos_fname; + loc + +let copy ~filename ~copyloc copied : srcloc = + Cpy { copied; copyloc = { filename; copyloc } } + +let replacement ~old ~new_ ~in_area_a ~replloc : srcloc = + Rpl { old; new_; in_area_a; replloc } + + +(* let is_copy = function *) +(* | Cpy _ -> true *) +(* | _ -> false *) + +(* let rec last_copy_origin: type t. t slt -> string option = function *) +(* | Raw _ -> None *) +(* | Rpl { replaced; _ } -> *) +(* last_copy_origin replaced *) +(* | Cat {left; right} -> *) +(* begin match last_copy_origin left with *) +(* | None -> last_copy_origin right *) +(* | _ as v -> v *) +(* end *) +(* | Cpy {copyloc = {filename; _}; _} -> Some filename *) + +(** [concat l1 l2] concatenates two adjacent source locations [l1] and [l2]. *) +let rec concat: srcloc -> srcloc -> srcloc = fun l1 l2 -> match l1, l2 with + | Raw (s1, e1, in_area_a), + Raw (s2, e2, _) + when e1.pos_fname = s2.pos_fname && e1.pos_cnum = s2.pos_cnum - 1 -> + Raw (s1, e2, in_area_a) + + | Cpy { copied = l1; copyloc = c1 }, + Cpy { copied = l2; copyloc = c2 } + when same_copyloc c1 c2 -> + Cpy { copied = concat l1 l2; copyloc = c1 } + + | (Cat { left; right = Cpy { copied = l1; copyloc = c1 } }), + (Cpy { copied = l2; copyloc = c2 }) + when same_copyloc c1 c2 -> + Cat { left; right = Cpy { copied = concat l1 l2; copyloc = c1 } } + + | Rpl { new_ = s1; old = l1; replloc; in_area_a }, (* unlikely *) + Rpl { new_ = s2; old = l2; replloc = replloc'; _ } + when l1 == l2 && replloc == replloc' -> (* note: physical equality *) + Rpl { new_ = concat s1 s2; old = l1; replloc; in_area_a } + + | (Cat { left; right = Rpl { new_ = s1; old = l1; replloc; in_area_a }}), + (Rpl { new_ = s2; old = l2; replloc = replloc'; _ }) + when l1 == l2 && replloc == replloc' -> (* note: physical equality *) + Cat { left; right = Rpl { new_ = concat s1 s2; old = l1; + replloc; in_area_a }} + + | (Raw _ | Cpy _ | Rpl _ | Cat _ as left), + (Cpy _ | Rpl _ | Raw _ as right) -> + Cat { left; right } + + | (Raw _ | Cpy _ | Rpl _ | Cat _ as l1), + (Cat { left = l2; right }) -> + Cat { left = concat l1 l2; right } + +let concat_srclocs: srcloc list -> srcloc option = fun l -> + List.fold_left begin fun acc loc -> match acc with + | None -> Some loc + | Some acc -> Some (concat acc loc) + end None l + +(** Direction for {!take} and {!trunc} below (internal) *) +type direction = Prefix | Suffix + +let show_direction = function + | Prefix -> "prefix" + | Suffix -> "suffix" + +(** [take direction length l] computes a source location for the prefix or + suffix of length [length] of [l]. Shows some warnings on [stderr] in case + [length] exceeds the length of [l]. *) +let take direction length loc = + (* Assumes raw lexlocs do not span over several lines *) + let open Lexing in + let rec take: type k. _ -> k slt -> _ = fun length -> function + | Raw (s, e, a) as loc -> + let len = e.pos_cnum - s.pos_cnum in + if len > length + then match direction with + | Prefix -> + Raw (s, { e with pos_cnum = s.pos_cnum + length }, a), 0 + | Suffix -> + Raw ({ s with pos_cnum = e.pos_cnum - length }, e, false), 0 + else loc, length - len + | Cpy ({ copied; _ } as cpy) -> + let copied, rem = take length copied in + Cpy { cpy with copied }, rem + | Rpl ({ new_; _ } as rpl) -> + let new_, rem = take length new_ in + Rpl { rpl with new_ }, rem + | Cat { left; right } -> match direction with + | Prefix -> + let left, rem = take length left in + if rem <= 0 then loc, rem else + let right, rem = take rem right in + concat left right, rem + | Suffix -> + let right, rem = take length right in + if rem <= 0 then loc, rem else + let left, rem = take rem left in + concat left right, rem + in + let loc', rem = take length loc in + if rem < 0 then + Pretty.error + "%a@\n>> Internal warning in `%s.take`: requested %s (%d) is longer than \ + source location (by %d)@.\ + " pp_srcloc loc __MODULE__ (show_direction direction) length (- rem); + loc' + +(** [trunc direction length l] truncates a prefix or suffix of length [length] + from a source location [l]. Shows some warnings on [stderr] in case + [length] exceeds the length of [l]. *) +let trunc direction length loc = + (* Assumes raw lexlocs do not span over several lines *) + let open Lexing in + let rec cut: type k. _ -> k slt -> _ = fun length -> function + | (Raw _ | Cpy _ | Rpl _ | Cat _) as loc + when length == 0 -> + Some loc, 0 + | Raw (s, e, a) -> + let len = e.pos_cnum - s.pos_cnum in + if len > length + then match direction with + | Prefix -> + Some (Raw ({ s with pos_cnum = s.pos_cnum + length }, e, false)), 0 + | Suffix -> + Some (Raw (s, { e with pos_cnum = e.pos_cnum - length }, a)), 0 + else None, length - len + | Cpy ({ copied; _ } as cpy) -> + begin match cut length copied with + | Some copied, rem -> Some (Cpy { cpy with copied }), rem + | res -> res + end + | Rpl ({ new_; _ } as rpl) -> + begin match cut length new_ with + | Some new_, rem -> Some (Rpl { rpl with new_ }), rem + | res -> res + end + | Cat { left; right } -> match direction with + | Prefix -> + begin match cut length left with + | Some left, rem -> Some (Cat { left; right }), rem + | None, rem -> cut rem right + end + | Suffix -> + begin match cut length right with + | Some right, rem -> Some (concat left right), rem + | None, rem -> cut rem left + end + in + match cut length loc with + | Some loc', rem when rem == 0 -> + loc' + | loc', rem -> + if rem < 0 then + Pretty.error + "%a@\n>> Internal warning in `%s.trunc`: taken out %s (%d) is longer \ + than source location (by %d)@.\ + " pp_srcloc loc __MODULE__ (show_direction direction) length (- rem); + Option.value loc' ~default:loc + +(** [prefix prefix_length l] computes a source location for the prefix of length + [prefix_length] of [l]. Shows some warnings on [stderr] in case + [prefix_length] exceeds the length of [l]. *) +let prefix prefix_length loc = take Prefix prefix_length loc + +(** [suffix suffix_length l] computes a source location for the suffix of length + [suffix_length] of [l]. Shows some warnings on [stderr] in case + [suffix_length] exceeds the length of [l]. *) +let suffix suffix_length loc = take Suffix suffix_length loc + +(** [trunc_prefix prefix_length l] truncates a prefix of length [prefix_length] + from a source location [l]. Shows some warnings on [stderr] in case + [prefix_length] exceeds the length of [l]. *) +let trunc_prefix prefix_length loc = trunc Prefix prefix_length loc +let trunc_suffix suffix_length loc = trunc Suffix suffix_length loc + +let sub loc ~pos ~len = + let loc = if pos > 0 then trunc_prefix pos loc else loc in + prefix len loc + +(** {2 Manipulating localized values} *) + +let pp pe ppf e = pe ppf e.payload (* ignore source localization *) +let pp_with_loc = pp +let flagit payload loc = { payload; loc } +let payload: 'a with_loc -> 'a = fun e -> e.payload +let loc: 'a with_loc -> srcloc = fun e -> e.loc +let as_pair e = e.payload, e.loc +let locfrom: 'a -> 'b with_loc -> 'a with_loc = fun payload b -> + flagit payload (loc b) +let locmap: ('a -> 'b) -> 'a with_loc -> 'b with_loc = fun f a -> + flagit (f (payload a)) (loc a) + +module INFIX : sig + (* Meaning of letters: + * '~' means projection + * '&' means payload + * '@' means location + * '?' means map-option + *) + val ( &@ ): 'a -> srcloc -> 'a with_loc + val ( &@<- ): 'a -> 'b with_loc -> 'a with_loc + + val ( ~& ): 'a with_loc -> 'a + val ( ~@ ): 'a with_loc -> srcloc + val ( ~&? ): 'a with_loc option -> 'a option + val ( ~@? ): 'a with_loc option -> srcloc option + val ( ~&@ ): 'a with_loc -> 'a * srcloc +end = struct + (* Fabrice: the use of non-standard infix operators is a nightmare for + external reviewers and newcomers. *) + + let ( &@ ) = flagit + let ( &@<- ) = locfrom + let ( ~& ) = payload + let ( ~&? ) e = Option.map (~&) e + let ( ~@ ) = loc + let ( ~@? ) e = Option.map (~@) e + let ( ~&@ ) = as_pair + +end +open INFIX + +let lift_option: 'a option with_loc -> 'a with_loc option = fun a -> + Option.map (fun x -> x &@<- a) ~&a + +let lift_result: ('a, 'e) result with_loc -> ('a with_loc, 'e with_loc) result = + fun rs -> + Result.(fold ~&rs + ~ok:(fun a -> Ok (a &@<- rs)) + ~error:(fun e -> Error (e &@<- rs))) + +let concat_locs: _ with_loc list -> srcloc option = fun l -> + List.fold_left begin fun acc { loc; _ } -> match acc with + | None -> Some loc + | Some acc -> Some (concat acc loc) + end None l + +let concat_strings_with_loc v w = (~&v ^ ~&w) &@ (concat ~@v ~@w) + +let copy_from ~filename ~copyloc { payload; loc } = + { payload; loc = copy ~filename ~copyloc loc } + +(* --- *) + +module COPYLOCS = struct + (** Helper to record and format chains of copied libraries. *) + + type t = copyloc list (* reversed *) + + let none: t = [] + let append ~copyloc filename : t -> t = List.cons { filename; copyloc } + let mem: string -> t -> bool = fun f -> + List.exists (fun { filename; _ } -> filename = f) + +end + +(* TODO: move me to a better place. This type declaration has to be + shared by Common_ast and Common_preproc *) +(* NB: not necessarily. One refers to pre-processing concept, the other to the + semantics of some COBOL statements like INSPECT or EXAMINE. *) +type leading_or_trailing = + | Leading + | Trailing +[@@deriving show, ord] diff --git a/src/lsp/cobol_common/srcloc.mli b/src/lsp/cobol_common/srcloc.mli new file mode 100644 index 000000000..bb584946c --- /dev/null +++ b/src/lsp/cobol_common/srcloc.mli @@ -0,0 +1,118 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module TYPES: sig + type lexloc = Lexing.position * Lexing.position + type srcloc + type 'a with_loc = { payload: 'a; loc: srcloc; } + [@@deriving ord] +end +type lexloc = TYPES.lexloc +type srcloc = TYPES.srcloc +type 'a with_loc = 'a TYPES.with_loc = + { payload: 'a; loc: srcloc; } [@@deriving ord] + +module INFIX: sig + (* Meaning of letters: + * '~' means projection + * '&' means payload + * '@' means location + * '?' means map-option + *) + val ( &@ ): 'a -> srcloc -> 'a with_loc + val ( &@<- ): 'a -> 'b with_loc -> 'a with_loc + val ( ~& ): 'a with_loc -> 'a + val ( ~&? ): 'a with_loc option -> 'a option + val ( ~@ ): 'a with_loc -> srcloc + val ( ~@? ): 'a with_loc option -> srcloc option + val ( ~&@ ): 'a with_loc -> 'a * srcloc +end + +val pp_srcloc: srcloc Pretty.printer +val pp_file_loc: srcloc Pretty.printer +val raw + : ?in_area_a:bool + -> lexloc + -> srcloc +val copy + : filename:string + -> copyloc:srcloc + -> srcloc + -> srcloc +val replacement + : old:srcloc + -> new_: srcloc + -> in_area_a: bool + -> replloc: srcloc + -> srcloc + +val forget_preproc + : favor_direction:[`Left | `Right] + -> traverse_copies:bool + -> traverse_replaces:bool + -> srcloc + -> lexloc +val as_lexloc + : srcloc + -> lexloc +val lexloc_in + : filename: string + -> srcloc + -> lexloc +val as_unique_lexloc + : srcloc + -> lexloc option +val as_copy + : srcloc + -> string with_loc option + +val in_area_a: srcloc -> bool +val start_pos: srcloc -> Lexing.position (* only suitable for Area A checks *) +val start_pos_in: filename: string -> srcloc -> Lexing.position +val end_pos_in: filename: string -> srcloc -> Lexing.position + +val fold_lexlocs: (lexloc -> 'a -> 'a) -> srcloc -> 'a -> 'a +val has_lexloc: (lexloc -> bool) -> srcloc -> bool + +val concat: srcloc -> srcloc -> srcloc +val concat_srclocs: srcloc list -> srcloc option +val prefix: int -> srcloc -> srcloc +val suffix: int -> srcloc -> srcloc +val trunc_prefix: int -> srcloc -> srcloc +val trunc_suffix: int -> srcloc -> srcloc +val sub : srcloc -> pos:int -> len:int -> srcloc + +val pp: 'a Pretty.printer -> 'a with_loc Pretty.printer +val pp_with_loc: 'a Pretty.printer -> 'a with_loc Pretty.printer +val flagit: 'a -> srcloc -> 'a with_loc +val payload: 'a with_loc -> 'a +val loc: 'a with_loc -> srcloc +val as_pair: 'a with_loc -> 'a * srcloc +val locfrom: 'a -> 'b with_loc -> 'a with_loc +val locmap: ('a -> 'b) -> 'a with_loc -> 'b with_loc + +val lift_option: 'a option with_loc -> 'a with_loc option +val lift_result: ('a, 'e) result with_loc -> ('a with_loc, 'e with_loc) result +val concat_locs: _ with_loc list -> srcloc option +val concat_strings_with_loc: string with_loc -> string with_loc -> string with_loc +val copy_from: filename:string -> copyloc:srcloc -> 'a with_loc -> 'a with_loc + +module COPYLOCS: sig + type t + val none: t + val append: copyloc:srcloc -> string -> t -> t + val mem: string -> t -> bool +end + +type leading_or_trailing = Leading | Trailing +[@@deriving show, ord] diff --git a/src/lsp/cobol_common/tokenizing.ml b/src/lsp/cobol_common/tokenizing.ml new file mode 100644 index 000000000..2a9f44a39 --- /dev/null +++ b/src/lsp/cobol_common/tokenizing.ml @@ -0,0 +1,31 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Srcloc.INFIX + +(** [fold_tokens ~tokenizer ~until ~f acc loc w] tokenizes [w] using + [tokenizer], and folds over generated tokens using [f]. *) +let fold_tokens ~tokenizer ~until ?next_tokenizer ~f w acc = + let lb = Lexing.from_string ~with_positions:true ~&w in + let rec aux ~loc ~tokenizer acc = match tokenizer ~loc lb with + | t when until t -> + acc + | t -> + let len = Lexing.(lexeme_end lb - lexeme_start lb) in + let loc = Lazy.force loc in + let loc = lazy (Srcloc.trunc_prefix len loc) + and tloc = Srcloc.prefix len loc in + aux ~loc (f (t &@ tloc) acc) + ~tokenizer:(match next_tokenizer with Some f -> f t | _ -> tokenizer) + in + aux ~tokenizer ~loc:(lazy ~@w) acc diff --git a/src/lsp/cobol_common/tokenizing.mli b/src/lsp/cobol_common/tokenizing.mli new file mode 100644 index 000000000..6f548ac93 --- /dev/null +++ b/src/lsp/cobol_common/tokenizing.mli @@ -0,0 +1,19 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val fold_tokens + : tokenizer:((loc:Srcloc.srcloc Lazy.t -> Lexing.lexbuf -> 'a) as 't) + -> until:('a -> bool) + -> ?next_tokenizer:('a -> 't) + -> f:('a Srcloc.with_loc -> 'b -> 'b) + -> string Srcloc.with_loc -> 'b -> 'b diff --git a/src/node-js-stubs/version.mlt b/src/lsp/cobol_common/version.mlt similarity index 100% rename from src/node-js-stubs/version.mlt rename to src/lsp/cobol_common/version.mlt diff --git a/src/lsp/cobol_common/visitor.ml b/src/lsp/cobol_common/visitor.ml new file mode 100644 index 000000000..3f335bbe0 --- /dev/null +++ b/src/lsp/cobol_common/visitor.ml @@ -0,0 +1,219 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** {1 Tree Visitors} + + Tree visitors as implemented here are objects that define one method for + each type of node to be visited. Such visitors are associated (and + implemented using) a set of functions that are visiting starting points. + + {2 Conventions} + + In the module of a visitor [V]: + + - the (currently unique) visitor is defined as a class [folder]; + + - the action to be performed when visiting (folding) a type [t] is specified + using a method [fold_t] of [folder]; + + - the starting point for a type [t] is [V.fold_t]. + + {b Note:} a type {!type:Srcloc.with_loc} is denoted with a prime ([']). For + instance, the starting point for a node of type [t with_loc] will be + [V.fold_t']. This convention also guides the naming of utilities + below. *) + +open Srcloc.TYPES + +(** {2 Types} + + The type of actions depends on the kind of visitor. For now, only a folding + visitor is available: *) + +(** Action to be performed when visiting a node: *) +type 'a folding_action = + | SkipChildren of 'a (** do not visit any of the node's children, and continue + with the given value *) + | DoChildren of 'a (** visit the node's children *) + | DoChildrenAndThen of 'a * ('a -> 'a) (** visit the node's children, and then + call the given function *) + +(** {3 Utilities for writing visitors} *) + +module INFIX = struct + (** Temporary binding, until `|>` is properly indented like a monadic operator + by ocp-indent. *) + let ( >> ) = ( |> ) +end +open INFIX + +let report = (* to be kept until visitors are complete *) + let module REPORTED = + Hashtbl.Make (struct + type t = string * string * int * string + let equal = (=) + let hash = Hashtbl.hash + end) + in + let reported_table = lazy (REPORTED.create 17) in + fun k file_name module_name line_num func_name -> + let tbl = Lazy.force reported_table in + if not (REPORTED.mem tbl (file_name, module_name, line_num, func_name)) + then begin + Pretty.error "@[<2>%s:%u:@ (%s.%s):@ %s@ visitor@ implementation@]@." + file_name line_num module_name func_name k; + REPORTED.add tbl (file_name, module_name, line_num, func_name) () + end + +(** {3 Specific visitors} *) + +(** Visitor that accumulates over the nodes of the tree. *) +module Fold = struct + + type 'a action = 'a folding_action + type ('x, 'a) fold = 'x -> 'a -> 'a folding_action + + (** Some combinators to write more readable folding visitors *) + + let skip_children x = SkipChildren x + let skip = skip_children (* alias *) + let do_children x = DoChildren x + let proceed = do_children (* alias *) + let do_children_and_then x f = DoChildrenAndThen (x, f) + let proceed_and_then = do_children_and_then (* alias *) + + let default _ = do_children (* default action *) + + (** Action handling *) + + (** [handle fold continue node acc] first calls [fold node acc], and then + behaves according to the action returned. *) + let handle (fold: 'x -> 'a -> 'a action) ~(continue: 'x -> 'a -> 'a) n x = + match fold n x with + | SkipChildren x -> x + | DoChildren x -> continue n x + | DoChildrenAndThen (x, f) -> continue n x >> f + + (** [leaf fold node acc] calls [fold node acc] and returns immediately (after + executing the post action, if [fold] returns + {!val:DoChildrenAndThen}). *) + let leaf (fold: 'x -> 'a -> 'a action) = + handle fold ~continue:(fun _ -> Fun.id) + + (** Base folding visitor. *) + class ['a] folder = object + method fold_bool: bool -> 'a -> 'a action = default + method fold_char: char -> 'a -> 'a action = default + method fold_int: int -> 'a -> 'a action = default + method fold_string: string -> 'a -> 'a action = default + method fold_option: 'x. 'x option -> 'a -> 'a action = default + method fold_list: 'x. 'x list -> 'a -> 'a action = default + method fold': 'x. 'x with_loc -> 'a -> 'a action = default + end + + (** Entry points for folding over some basic types. *) + + let fold_bool (v: _ #folder) = leaf v#fold_bool + let fold_char (v: _ #folder) = leaf v#fold_char + let fold_int (v: _ #folder) = leaf v#fold_int + let fold_string (v: _ #folder) = leaf v#fold_string + + (** Generic entry points. *) + + let fold_option ~fold (v: _ #folder) = + handle v#fold_option + ~continue:(Option.fold ~none:Fun.id ~some:(fold v)) + + let fold_list ~fold (v: _ #folder) = + handle v#fold_list + ~continue:(fun l x -> List.fold_left (fun x a -> fold v a x) x l) + + let fold' ~fold (v: _ #folder) = + handle v#fold' ~continue:(fun { payload; _ } -> fold v payload) + + let fold_string' (v: _ #folder) = + fold' ~fold:fold_string v + + let fold_string'_opt (v: _ #folder) = + fold_option ~fold:fold_string' v + + let fold_with_loc_list ~fold (v: _ #folder) = + fold_list v ~fold:(fold' ~fold) + + (** Helper to shorten definitions for traversal of nodes with source + locations *) + let handle' vfold ~fold (v: _ #folder) = + handle vfold ~continue:(fold' ~fold v) + + (* --- *) + + (** Reports a missing folding visitor implementation {e once}. *) + let todo a b c d _ x = report "missing" a b c d; x + + (** Reports a partial folding visitor implementation {e once}. *) + let partial a b c d x = report "partial" a b c d; x + +end + +(* --- *) + +(** Folder that carries a context *) +module Fold_with_context = struct + + (* TODO: to be extended to the ASTs if really needed; priority is in completing + the basic one above first *) + + type 'a action = 'a folding_action + + let do_children _ctx x = DoChildren x + let proceed = do_children (* alias *) + + let default _ = do_children (* default action *) + + (* Action handling *) + + let handle (fold: 'x -> 'c -> 'a -> 'a action) ~(continue: 'x -> 'c -> 'a -> 'a) ctx n x = + match fold ctx n x with + | SkipChildren x -> x + | DoChildren x -> continue ctx n x + | DoChildrenAndThen (x, f) -> continue ctx n x >> f + + let leaf (fold: 'x -> 'c -> 'a -> 'a action) = + handle fold ~continue:(fun _ctx _ -> Fun.id) + + class ['a, 'c] folder = object + method fold_bool: 'c -> bool -> 'a -> 'a action = default + method fold_char: 'c -> char -> 'a -> 'a action = default + method fold_int: 'c -> int -> 'a -> 'a action = default + method fold_string: 'c -> string -> 'a -> 'a action = default + method fold_option: 'x. 'c -> 'x option -> 'a -> 'a action = default + method fold_list: 'x. 'c -> 'x list -> 'a -> 'a action = default + end + + let fold_bool (v: (_, _) #folder) = leaf v#fold_bool + let fold_char (v: (_, _) #folder) = leaf v#fold_char + let fold_int (v: (_, _) #folder) = leaf v#fold_int + let fold_string (v: (_, _) #folder) = leaf v#fold_string + let fold_option ~fold (v: (_, _) #folder) = + handle v#fold_option + ~continue:(Option.fold ~none:(fun _ctx -> Fun.id) ~some:(fold v)) + let fold_list ~fold (v: (_, _) #folder) = + handle v#fold_list + ~continue:(fun ctx l x -> List.fold_left (fun x a -> fold v ctx x a) x l) + +end + +(* --- *) + +(* Fold by default. *) +include Fold diff --git a/src/lsp/cobol_config/README.md b/src/lsp/cobol_config/README.md new file mode 100644 index 000000000..f796326f3 --- /dev/null +++ b/src/lsp/cobol_config/README.md @@ -0,0 +1,5 @@ +# Cobol_config package + +This package is used to parse config files and generate configurations to use `superbol`. + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_config/cobol_config.ml b/src/lsp/cobol_config/cobol_config.ml new file mode 100644 index 000000000..2b821ca70 --- /dev/null +++ b/src/lsp/cobol_config/cobol_config.ml @@ -0,0 +1,278 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Basics + +include Types + +module Options = Options +module Default = Default + +module DIAGS = Cobol_common.Diagnostics +module FATAL = DIAGS.Fatal (* any error here should end up in exit. *) + +let print_options: Pretty.delayed = fun ppf -> + Pretty.list ~fopen:"@[" ~fsep:"@\n" ~fclose:"@]" (fun ppf v -> v#pp ppf) + ppf !all_configs + +(* --- *) + +let default = (module Default: T) + +let meet_support (s1: Conf_ast.support_value as 's) (s2: 's) : 's = + match s1, s2 with + | Ok, _ -> Ok + | Warning, (Warning | Archaic | Obsolete | Skip | Ignore | Error | + Unconformable) -> Warning + | Archaic, (Archaic | Obsolete | Skip | Ignore | Error | + Unconformable) -> Archaic + | Obsolete, (Obsolete | Skip | Ignore | Error | Unconformable) -> Obsolete + | Skip, (Skip | Ignore | Error | Unconformable) -> Skip + | Ignore, (Ignore | Error | Unconformable) -> Ignore + | Error, (Error | Unconformable) -> Error + | _ -> s2 + +let make_conf conf = + let error k v = + FATAL.error "Unexpected error for `%s` key: %a" k Conf_ast.pp_value v + in + let conf = + List.fold_left + (fun conf elt -> + match elt with + | Conf_ast.Value {key = "reserved"; value} -> + begin match value with + | ContextWord s -> + Words.RESERVED.add_reserved (s^"*") + | String s -> + Words.RESERVED.add_reserved s + | Alias (Normal (alias, base)) -> + Words.RESERVED.add_alias alias base + | Alias (Context (alias, base)) -> + Words.RESERVED.add_alias (alias^"*") base + | _ -> error "reserved" value + end; + conf + | Value {key = "not-reserved"; value = String s } -> + Words.RESERVED.remove_reserved s; + Words.INTRINSIC.remove_intrinsic s; + Words.SYSTEM_NAMES.remove_system_name s; + Words.REGISTERS.remove_register s; + conf + | Value {key = "not-reserved"; value } -> + error "not-reserved" value + | Value {key = "intrinsic-function"; value = String s } -> + Words.INTRINSIC.add_intrinsic s; + conf + | Value {key = "intrinsic-function"; value } -> + error "intrinsic-function" value + | Value {key = "not-intrinsic-function"; value = String s} -> + Words.INTRINSIC.remove_intrinsic s; + conf + | Value {key = "not-intrinsic-function"; value} -> + error "not-intrinsic-function" value + | Value {key = "system-name"; value = String s} -> + Words.SYSTEM_NAMES.add_system_name s; + conf + | Value {key = "system-name"; value} -> + error "system-name" value + | Value {key = "not-system-name"; value = String s} -> + Words.SYSTEM_NAMES.remove_system_name s; + conf + | Value {key = "not-system-name"; value} -> + error "not-system-name" value + | Value {key = "register"; value = String s} -> + Words.REGISTERS.add_register s; + conf + | Value {key = "register"; value} -> + error "register" value + | Value {key = "not-register"; value = String s} -> + Words.REGISTERS.remove_register s; + conf + | Value {key = "not-register"; value} -> + error "not-register" value + | Value {key; value} -> + let value = match value with + | Support (Additional s) -> + begin match StringMap.find_opt key conf with + | Some (Conf_ast.Support (Additional v | Normal v)) -> + Conf_ast.Support (Normal (meet_support s v)) + | _ -> value + end + | _ -> value + in + let conf = StringMap.add key value conf in + conf + | Include s -> + FATAL.error "Unresolved include: %s" s + | ReservedWords s -> + FATAL.error "Unresolved reserved words: %s.words" s) + StringMap.empty + conf + in + (conf, + Words.RESERVED.words (), + Words.INTRINSIC.intrinsic_functions (), + Words.SYSTEM_NAMES.system_names (), + Words.REGISTERS.registers ()) + + +let parse_file file = + let open Lexing in + let module I = Conf_parser.MenhirInterpreter in + let rec handle_parser_error lexbuf checkpoint = + match checkpoint with + | I.HandlingError env -> + begin match I.stack env with + | lazy Nil -> + let loc = Cobol_common.Srcloc.raw (lexbuf.lex_start_p, lexbuf.lex_curr_p) in + FATAL.error ~loc "Syntax error" + | lazy (Cons (I.Element (state, _, start_pos, end_pos), _)) -> + let loc = Cobol_common.Srcloc.raw (start_pos, end_pos) in + FATAL.error ~loc "Syntax error: %s" @@ + try Conf_parser_messages.message (I.number state) with Not_found -> "" + end; + | I.Rejected -> + FATAL.error "Syntax error: input reject"; + | _ -> parse lexbuf checkpoint + and parse lexbuf (checkpoint: Conf_ast.t I.checkpoint) = + I.loop_handle + Fun.id + (handle_parser_error lexbuf) + (fun () -> + let token = Conf_lexer.main lexbuf in + token, lexbuf.lex_start_p, lexbuf.lex_curr_p) + checkpoint + in + let ic = open_in file in + let lexbuf = Lexing.from_channel ~with_positions:true ic in + let ast = + try parse lexbuf (Conf_parser.Incremental.file lexbuf.lex_curr_p) + with Conf_lexer.LexError (msg, start_p, end_p) -> + let loc = Cobol_common.Srcloc.raw (start_p, end_p) in + FATAL.error ~loc "Lexing Error: %s" msg; + in + close_in ic; + ast + +let path_to_search = + lazy begin + let cwd = Ez_file.FileString.getcwd () in + let l = "/usr/local/share/gnucobol/config"::[] in + let l = match Sys.getenv_opt "COB_CONFIG_DIR" with + | Some d -> d::l + | None -> l + in + let xdg_conf = match Sys.getenv_opt "XDG_CONFIG_HOME" with + | None -> Ez_file.FileString.add_path (Sys.getenv "HOME") ".config" + | Some p -> p + in + cwd :: Ez_file.FileString.add_path xdg_conf "superbol" :: l + end + +let first_file paths filename = + Cobol_common.Basics.LIST.fold_left_while + Option.is_none + (fun _ dir -> + let filepath = Ez_file.FileString.add_path dir filename in + if Ez_file.FileString.exists filepath then + if not @@ Ez_file.FileString.is_directory filepath then + Some filepath + else + None + else + None) + None + paths + + +let from_file (module Diags: DIAGS.STATEFUL) ?(dialect: dialect option) file = + let rec aux file = + let options = parse_file file in + let path_to_search = + Ez_file.FileString.dirname file :: Lazy.force path_to_search + in + List.fold_left begin fun acc option -> match option with + | Conf_ast.Value _ -> + acc @ [option] + | ReservedWords words + when (String.lowercase_ascii words) <> "off" && + (String.lowercase_ascii words) <> "default" -> + let basename = String.lowercase_ascii words in + let filename = Ez_file.FileString.add_suffix basename ".words" in + begin match first_file path_to_search filename with + | Some file_path -> + acc @ aux file_path + | None -> + FATAL.error "Words@ file@ not@ found:@ %s" filename; + end + | ReservedWords words + when words = "default" -> + Words.RESERVED.add_reserved "DIALECT-ALL"; + acc + | ReservedWords _ -> + acc + | Include file -> + begin match first_file path_to_search file with + | Some file_path -> + acc @ aux file_path + | None -> + FATAL.error "Configuration@ file@ not@ found:@ %s" file + end + end [] options + in + Pretty.error "@[Loading@ configuration@ from@ `%s'@]@." file; + let options = aux file in + let options, words, intrinsic, system_names, registers + = make_conf options in + let module Config = + From_file.Make (Diags) (struct + let config = + { name = match StringMap.find "name" options with + | Conf_ast.String s -> s + | v -> Pretty.failwith "Expecting a string for the `name' option, \ + got: %a" Conf_ast.pp_value v } + let dialect = match dialect with + | Some d -> d + | None -> try DIALECT.of_name config.name with + | Invalid_argument _ -> FATAL.error "unknown dialect: %s" config.name + let options = options + let words = words + let intrinsic_functions = intrinsic + let system_names = system_names + let registers = registers + end) + in + (module Config: T) + +let try_from_file (module Diags: DIAGS.STATEFUL) dialect file = + match first_file (Lazy.force path_to_search) file with + | Some f -> + from_file (module Diags) ~dialect f + | None -> + FATAL.error "Unable@ to@ locate@ a@ configuration@ file@ for@ dialect:@ \ + `%s'" (DIALECT.name dialect) + +let from_dialect (module Diags: DIAGS.STATEFUL) ~strict d = + let load_gnucobol_conf dialect ~strict confname = + try_from_file (module Diags) dialect + (Pretty.to_string "%s%s.conf" confname (if strict then "-strict" else "")) + in + match d with + | DIALECT.Default -> (module Default: T) + | COBOL85 -> load_gnucobol_conf d ~strict:false "cobol85" + | GnuCOBOL -> load_gnucobol_conf d ~strict:false "default" + | ACU -> load_gnucobol_conf d ~strict "acu" + | MicroFocus -> load_gnucobol_conf d ~strict "mf" + | GCOS -> load_gnucobol_conf d ~strict "gcos" + | IBM -> load_gnucobol_conf d ~strict "ibm" diff --git a/src/lsp/cobol_config/cobol_config.mli b/src/lsp/cobol_config/cobol_config.mli new file mode 100644 index 000000000..098d5592e --- /dev/null +++ b/src/lsp/cobol_config/cobol_config.mli @@ -0,0 +1,40 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This library is used to build configuration modules, either from file or + from a dialect. All the [from_] functions will fail if a file is not found, + or use the default value of any options that is badly typed in the + configuration file or not set in the configuration file.*) + +include module type of Types + +module Options = Options +module Default = Default + +val print_options: Format.formatter -> unit + +val default: (module T) + +val from_file + : (module Cobol_common.Diagnostics.STATEFUL) + -> ?dialect: Types.DIALECT.t + -> string + -> (module T) + +(** [from_dialect (module Diags) ?strict dialect] returns the configuration + module according to the dialect defaults. *) +val from_dialect + : (module Cobol_common.Diagnostics.STATEFUL) + -> strict: bool + -> Types.DIALECT.t + -> (module T) diff --git a/src/lsp/cobol_config/conf_ast.ml b/src/lsp/cobol_config/conf_ast.ml new file mode 100644 index 000000000..86329e65f --- /dev/null +++ b/src/lsp/cobol_config/conf_ast.ml @@ -0,0 +1,62 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +type support_value = + | Ok + | Warning + | Archaic + | Obsolete + | Skip + | Ignore + | Error + | Unconformable + +type support = + | Normal of support_value + | Additional of support_value + +type alias = + | Normal of string * string + | Context of string * string + +type value = + | Any of string + | Bool of bool + | Int of int + | String of string + | Support of support + | ContextWord of string + | Alias of alias + +let pp_value fmt = function + | Any s -> Pretty.print fmt "any (%s)" s + | Bool b -> Pretty.print fmt "boolean (%B)" b + | Int i -> Pretty.print fmt "integer (%d)" i + | String s -> Pretty.print fmt "string (%s)" s + | ContextWord s -> Pretty.print fmt "word (%s*)" s + | Support _ -> Pretty.print fmt "support" + | Alias (Context (a, v)) -> Pretty.print fmt "alias (%s*=%s)" a v + | Alias (Normal (a, v)) -> Pretty.print fmt "alias (%s=%s)" a v + + +type set_value = + { key: string; + value: value; } + +type conf_node = + | ReservedWords of string + | Include of string + | Value of set_value + +type t = conf_node list + diff --git a/src/lsp/cobol_config/conf_lexer.mll b/src/lsp/cobol_config/conf_lexer.mll new file mode 100644 index 000000000..484f6aa14 --- /dev/null +++ b/src/lsp/cobol_config/conf_lexer.mll @@ -0,0 +1,93 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +{ + open Lexing + open Conf_parser + exception LexError of string * Lexing.position * Lexing.position +} + +let newline = '\r'* '\n' +let spaces = [' ' '\t'] +let letter = ['a'-'z' 'A'-'Z'] +let digit = ['0'-'9'] +let punct = (newline | spaces) +let true = "true" +let false = "false" +let yes = "yes" +let no = "no" +let boolean = true | false | yes | no +let integer = ('+' | '-')? digit+ +let ident_chars = letter | '-' | digit +let ident = letter ident_chars* +let value_char = letter | digit +let value = value_char (value_char | '-' | '_')* + +let reserved_words = "reserved-words" +let reserved = "reserved" +let not_reserved = "not-reserved" +let intrinsic_function = "intrinsic-function" +let not_intrinsic_function = "not-intrinsic-function" +let system_name = "system-name" +let not_system_name = "not-system-name" +let register = "register" +let not_register = "not-register" +let include = "include" + +rule main = parse +| newline { Lexing.new_line lexbuf; main lexbuf } +| spaces { main lexbuf } +| ":" { COLON } +| "#" { single_line_comment lexbuf } +| '"' { read_string (Buffer.create 17) lexbuf} +| "*" { STAR } +| "=" { EQ } +| "+" { PLUS } +| reserved_words { RESERVED_WORDS } +| reserved { RESERVED } +| not_reserved { NOT_RESERVED } +| intrinsic_function { INTRINSIC_FUNCTION } +| not_intrinsic_function { NOT_INTRINSIC_FUNCTION } +| system_name { SYSTEM_NAME} +| not_system_name { NOT_SYSTEM_NAME } +| register { REGISTER } +| not_register { NOT_REGISTER } +| "ok" { OK } +| "warning" { WARNING } +| "archaic" { ARCHAIC } +| "obsolete" { OBSOLETE } +| "skip" { SKIP } +| "ignore" { IGNORE } +| "error" { ERROR } +| "unconformable" { UNCONFORMABLE } +| include { INCLUDE } +| true | yes { BOOLEAN true } +| false | no { BOOLEAN false } +| integer as i { INT (int_of_string i) } +| ident as i { IDENT i } +| value as x { ANY x } +| _ as c { raise @@ LexError (Format.sprintf "Invalid char: %c" c, lexbuf.lex_start_p, lexbuf.lex_curr_p) } +| eof { EOF } + +and single_line_comment = parse +| newline { new_line lexbuf; main lexbuf } +| eof { EOF } +| _ { single_line_comment lexbuf } + +and read_string buf = parse +| '"' { STRING (Buffer.contents buf) } +| '\\' '\\' { Buffer.add_string buf "\\"; read_string buf lexbuf } +| '\\' '\ ' { Buffer.add_string buf "\ "; read_string buf lexbuf } +| [^ '"' '\\']+ { Buffer.add_string buf (Lexing.lexeme lexbuf); read_string buf lexbuf } +| _ as c { raise @@ LexError (Format.sprintf "Invalid char: %c" c, lexbuf.lex_start_p, lexbuf.lex_curr_p) } +| eof { raise @@ LexError ("Unexpected end of string", lexbuf.lex_start_p, lexbuf.lex_curr_p) } diff --git a/src/lsp/cobol_config/conf_parser.messages b/src/lsp/cobol_config/conf_parser.messages new file mode 100644 index 000000000..44149219e --- /dev/null +++ b/src/lsp/cobol_config/conf_parser.messages @@ -0,0 +1,173 @@ +file: WARNING +## +## Ends in an error in state: 0. +## +## file' -> . file [ # ] +## +## The known suffix of the stack is as follows: +## +## + +Expecting at least one rule in the configuration file. + +file: RESERVED WARNING +## +## Ends in an error in state: 2. +## +## word_rule -> RESERVED . option(COLON) ANY option(STAR) EQ ANY [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## word_rule -> RESERVED . option(COLON) ANY option(STAR) [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## RESERVED +## + +Expecting a ':', a word or an alias after 'reserved'. + +file: RESERVED COLON WARNING +## +## Ends in an error in state: 4. +## +## word_rule -> RESERVED option(COLON) . ANY option(STAR) EQ ANY [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## word_rule -> RESERVED option(COLON) . ANY option(STAR) [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## RESERVED option(COLON) +## + +Expecting a word or an alias after 'reserved'. + +file: RESERVED ANY WARNING +## +## Ends in an error in state: 5. +## +## word_rule -> RESERVED option(COLON) ANY . option(STAR) EQ ANY [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## word_rule -> RESERVED option(COLON) ANY . option(STAR) [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## RESERVED option(COLON) ANY +## + +Expecting another rule or end of file after a configuration rule. + +file: RESERVED ANY STAR WARNING +## +## Ends in an error in state: 7. +## +## word_rule -> RESERVED option(COLON) ANY option(STAR) . EQ ANY [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## word_rule -> RESERVED option(COLON) ANY option(STAR) . [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## RESERVED option(COLON) ANY option(STAR) +## + +Expecting another rule or end of file after a configuration rule. + +file: RESERVED ANY EQ WARNING +## +## Ends in an error in state: 8. +## +## word_rule -> RESERVED option(COLON) ANY option(STAR) EQ . ANY [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## RESERVED option(COLON) ANY option(STAR) EQ +## + +Expecting another word after '='. + +file: INCLUDE WARNING +## +## Ends in an error in state: 16. +## +## rule -> INCLUDE . option(COLON) STRING [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## INCLUDE +## + +Expecting a ':' or a string after 'include'. + +file: INCLUDE COLON WARNING +## +## Ends in an error in state: 17. +## +## rule -> INCLUDE option(COLON) . STRING [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## INCLUDE option(COLON) +## + +Expecting a string after 'include'. + +file: IDENT SYSTEM_NAME +## +## Ends in an error in state: 19. +## +## rule -> IDENT . option(COLON) value [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## IDENT +## + +Expecting a ':' or a value after an rule identifier. + +file: IDENT COLON SYSTEM_NAME +## +## Ends in an error in state: 20. +## +## rule -> IDENT option(COLON) . value [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## IDENT option(COLON) +## + +Expecting a value after a rule identifier. + +file: IDENT PLUS SYSTEM_NAME +## +## Ends in an error in state: 25. +## +## support -> PLUS . support_value [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## PLUS +## + +Expecting a support value after a '+'. + +file: INTRINSIC_FUNCTION WARNING +## +## Ends in an error in state: 40. +## +## word_rule -> word_key . option(COLON) any_or_string [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## word_key +## + +Expecting a word for this configuration rule. + +file: INTRINSIC_FUNCTION COLON WARNING +## +## Ends in an error in state: 41. +## +## word_rule -> word_key option(COLON) . any_or_string [ SYSTEM_NAME RESERVED REGISTER NOT_SYSTEM_NAME NOT_RESERVED NOT_REGISTER NOT_INTRINSIC_FUNCTION INTRINSIC_FUNCTION INCLUDE IDENT EOF ] +## +## The known suffix of the stack is as follows: +## word_key option(COLON) +## + +Expecting a word for this configuration rule. + +file: INTRINSIC_FUNCTION ANY WARNING +## +## Ends in an error in state: 48. +## +## rules -> rule . [ EOF ] +## rules -> rule . rules [ EOF ] +## +## The known suffix of the stack is as follows: +## rule +## + +Expecting another rule or end of file after a configuration rule. + diff --git a/src/lsp/cobol_config/conf_parser.mly b/src/lsp/cobol_config/conf_parser.mly new file mode 100644 index 000000000..ca480252b --- /dev/null +++ b/src/lsp/cobol_config/conf_parser.mly @@ -0,0 +1,111 @@ +(**************************************************************************) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) + +%{ +open Conf_ast +%} + +%token INT +%token BOOLEAN (* Because of `yes`/`no` *) +%token IDENT +%token ANY +%token STRING +%token INCLUDE +%token COLON +%token STAR +%token EQ +%token PLUS + +%token OK +%token WARNING +%token ARCHAIC +%token OBSOLETE +%token SKIP +%token IGNORE +%token ERROR +%token UNCONFORMABLE +%token EOF + +%token RESERVED_WORDS +%token RESERVED +%token NOT_RESERVED +%token INTRINSIC_FUNCTION +%token NOT_INTRINSIC_FUNCTION +%token SYSTEM_NAME +%token NOT_SYSTEM_NAME +%token REGISTER +%token NOT_REGISTER + +%start file + +%% +let file := + | ~=rules; EOF; <> + +let rules := + | r=rule; { [r] } + | r=rule; rl=rules; { r::rl } + +let rule := + | INCLUDE; COLON?; ~=STRING; + | RESERVED_WORDS; COLON?; ~=any_or_string; + | ~=word_rule; <> + | key=IDENT; COLON?; value=value; { Value {key; value} } + +let word_rule := + | RESERVED; COLON?; alias=any_or_string; o=STAR?; EQ; word=any_or_string; + { let alias = match o with + | Some _ -> Context (alias, word) + | None -> Normal (alias, word) + in + Value {key = "reserved"; value = Alias alias} } + | RESERVED; COLON?; value=any_or_string; o=STAR?; + { Value {key = "reserved"; value = + match o with + | Some _ -> ContextWord value; + | None -> String value; } } + | key=word_key; COLON?; value=any_or_string; + { Value {key; value = String value} } + +let word_key := + | NOT_RESERVED; { "not-reserved" } + | INTRINSIC_FUNCTION; { "intrinsic-function" } + | NOT_INTRINSIC_FUNCTION; { "not-intrinsic-function" } + | SYSTEM_NAME; { "system-name" } + | NOT_SYSTEM_NAME; { "not-system-name" } + | REGISTER; { "register" } + | NOT_REGISTER; { "not-register" } + +let any_or_string := + | ~=ANY; <> + | ~=STRING; <> + | ~=IDENT; <> + +let value := + | ~=ANY; + | ~=BOOLEAN; + | ~=INT; + | ~=STRING; + | ~=IDENT; + | ~=support; + +let support := +| ~=support_value; +| PLUS; ~=support_value; + +let support_value := +| OK; { Ok } +| WARNING; { Warning } +| ARCHAIC; { Archaic } +| OBSOLETE; { Obsolete } +| SKIP; { Skip } +| IGNORE; { Ignore } +| ERROR; { Error } +| UNCONFORMABLE; { Unconformable } + diff --git a/src/lsp/cobol_config/default.ml b/src/lsp/cobol_config/default.ml new file mode 100644 index 000000000..627f394ca --- /dev/null +++ b/src/lsp/cobol_config/default.ml @@ -0,0 +1,311 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Module containing all the default options *) +open Cobol_common.Basics + +let not_reserved = + ["TERMINAL"; "EXAMINE"] + +let default_aliases = + [ "AUTO-SKIP", "AUTO"; + "AUTOTERMINATE", "AUTO"; + "BACKGROUND-COLOUR", "BACKGROUND-COLOR"; + "BEEP", "BELL"; + "BINARY-INT", "BINARY-LONG"; + "BINARY-LONG-LONG", "BINARY-DOUBLE"; + "CELLS", "CELL"; + "COLOURS", "COLORS"; + "EMPTY-CHECK", "REQUIRED"; + "EQUALS", "EQUAL"; + "FOREGROUND-COLOUR", "FOREGROUND-COLOR"; + "HIGH-VALUES", "HIGH-VALUE"; + "INITIALISE", "INITIALIZE"; + "INITIALISED", "INITIALIZED"; + "LENGTH-CHECK", "FULL"; + "LOW-VALUES", "LOW-VALUE"; + "ORGANISATION", "ORGANIZATION"; + "PIXELS", "PIXEL"; + "SYNCHRONISED", "SYNCHRONIZED"; + "TIMEOUT", "TIME-OUT"; + "ZEROES", "ZERO"; + "ZEROS", "ZERO"] + +module Default: Types.T = struct + open Types + let dialect = DIALECT.Default + let config = { name = DIALECT.name dialect } + + let words = + let alias_for b = ReserveAlias { alias_for = b; + preserve_context_sensitivity = false } in + Reserved_words.words @ + List.map (fun w -> w, NotReserved) not_reserved @ + List.map (fun (a, b) -> a, alias_for b) default_aliases + + let not_reserved = StringSet.of_list not_reserved + let intrinsic_functions = StringSet.diff Reserved_words.default_intrinsics not_reserved + let system_names = StringSet.diff Reserved_words.default_system_names not_reserved + let registers = StringSet.diff Reserved_words.default_registers not_reserved + + (* int options *) + open Options + let tab_width + = tab_width#from_val ~config 8 + let text_column + = text_column#from_val ~config 72 + let pic_length + = pic_length#from_val ~config 255 + let word_length + = word_length#from_val ~config 63 + let literal_length + = literal_length#from_val ~config 8191 + let numeric_literal_length + = numeric_literal_length#from_val ~config 38 + + (* any options *) + let defaultbyte + = defaultbyte#from_val ~config Init + let standard_define + = standard_define#from_val ~config GnuCOBOL + let format + = format#from_val ~config Auto + let binary_size + = binary_size#from_val ~config B_1_2_4_8 + let binary_byteorder + = binary_byteorder#from_val ~config Big_endian + let assign_clause + = assign_clause#from_val ~config Dynamic + let screen_section_rules + = screen_section_rules#from_val ~config GC + let dpc_in_data + = dpc_in_data#from_val ~config XML + + (* boolean options *) + let filename_mapping + = filename_mapping#from_val ~config true + let pretty_display + = pretty_display#from_val ~config true + let binary_truncate + = binary_truncate#from_val ~config true + let complex_odo + = complex_odo#from_val ~config false + let odoslide + = odoslide#from_val ~config false + let indirect_redefines + = indirect_redefines#from_val ~config false + let relax_syntax_checks + = relax_syntax_checks#from_val ~config false + let ref_mod_zero_length + = ref_mod_zero_length#from_val ~config true + let relax_level_hierarchy + = relax_level_hierarchy#from_val ~config false + let select_working + = select_working#from_val ~config false + let local_implies_recursive + = local_implies_recursive#from_val ~config false + let sticky_linkage + = sticky_linkage#from_val ~config false + let move_ibm + = move_ibm#from_val ~config false + let perform_osvs + = perform_osvs#from_val ~config false + let arithmetic_osvs + = arithmetic_osvs#from_val ~config false + let hostsign + = hostsign#from_val ~config false + let program_name_redefinition + = program_name_redefinition#from_val ~config true + let accept_update + = accept_update#from_val ~config false + let accept_auto + = accept_auto#from_val ~config false + let console_is_crt + = console_is_crt#from_val ~config false + let no_echo_means_secure + = no_echo_means_secure#from_val ~config false + let line_col_zero_default + = line_col_zero_default#from_val ~config true + let display_special_fig_consts + = display_special_fig_consts#from_val ~config false + let binary_comp_1 + = binary_comp_1#from_val ~config false + let numeric_pointer + = numeric_pointer#from_val ~config false + let move_non_numeric_lit_to_numeric_is_zero + = move_non_numeric_lit_to_numeric_is_zero#from_val ~config false + let implicit_assign_dynamic_var + = implicit_assign_dynamic_var#from_val ~config true + let device_mnemonics + = device_mnemonics#from_val ~config false + let xml_parse_xmlss + = xml_parse_xmlss#from_val ~config true + let areacheck + = areacheck#from_val ~config false + let ebcdic_symbolic_characters + = ebcdic_symbolic_characters#from_val ~config false + + (* support options *) + let comment_paragraphs + = comment_paragraphs#from_level ~config @@ Obsolete () + let safe_partial_replacing_when_src_literal + = safe_partial_replacing_when_src_literal#from_level ~config @@ Obsolete `Unsafe + let control_division + = control_division#from_level ~config Unconformable + let memory_size_clause + = memory_size_clause#from_level ~config @@ Obsolete () + let multiple_file_tape_clause + = multiple_file_tape_clause#from_level ~config @@ Obsolete () + let label_records_clause + = label_records_clause#from_level ~config @@ Obsolete () + let value_of_clause + = value_of_clause#from_level ~config @@ Obsolete () + let data_records_clause + = data_records_clause#from_level ~config @@ Obsolete () + let top_level_occurs_clause + = top_level_occurs_clause#from_level ~config @@ Ok () + let same_as_clause + = same_as_clause#from_level ~config @@ Ok () + let type_to_clause + = type_to_clause#from_level ~config @@ Ok () + let usage_type + = usage_type#from_level ~config @@ Ok () + let synchronized_clause + = synchronized_clause#from_level ~config @@ Ok () + let sync_left_right + = sync_left_right#from_level ~config @@ Ok () + let special_names_clause + = special_names_clause#from_level ~config @@ Ok () + let goto_statement_without_name + = goto_statement_without_name#from_level ~config @@ Obsolete () + let stop_literal_statement + = stop_literal_statement#from_level ~config @@ Obsolete () + let stop_identifier_statement + = stop_identifier_statement#from_level ~config @@ Obsolete () + let stop_error_statement + = stop_error_statement#from_level ~config Unconformable + let debugging_mode + = debugging_mode#from_level ~config @@ Ok () + let use_for_debugging + = use_for_debugging#from_level ~config @@ Ok () + let padding_character_clause + = padding_character_clause#from_level ~config @@ Obsolete () + let next_sentence_phrase + = next_sentence_phrase#from_level ~config @@ Archaic () + let listing_statements + = listing_statements#from_level ~config Skip + let title_statement + = title_statement#from_level ~config Skip + let entry_statement + = entry_statement#from_level ~config @@ Ok () + let move_noninteger_to_alphanumeric + = move_noninteger_to_alphanumeric#from_level ~config Error + let move_figurative_constant_to_numeric + = move_figurative_constant_to_numeric#from_level ~config @@ Archaic () + let move_figurative_space_to_numeric + = move_figurative_space_to_numeric#from_level ~config Error + let move_figurative_quote_to_numeric + = move_figurative_quote_to_numeric#from_level ~config @@ Obsolete () + let odo_without_to + = odo_without_to#from_level ~config @@ Warning () + let section_segments + = section_segments#from_level ~config Ignore + let alter_statement + = alter_statement#from_level ~config @@ Obsolete () + let call_overflow + = call_overflow#from_level ~config @@ Archaic () + let numeric_boolean + = numeric_boolean#from_level ~config @@ Ok () + let hexadecimal_boolean + = hexadecimal_boolean#from_level ~config @@ Ok () + let national_literals + = national_literals#from_level ~config @@ Ok () + let hexadecimal_national_literals + = hexadecimal_national_literals#from_level ~config @@ Ok () + let national_character_literals + = national_character_literals#from_level ~config @@ Warning () + let hp_octal_literals + = hp_octal_literals#from_level ~config Unconformable + let acu_literals + = acu_literals#from_level ~config Unconformable + let word_continuation + = word_continuation#from_level ~config @@ Warning () + let not_exception_before_exception + = not_exception_before_exception#from_level ~config @@ Ok () + let accept_display_extensions + = accept_display_extensions#from_level ~config @@ Ok () + let larger_redefines + = larger_redefines#from_level ~config Error + let symbolic_constant + = symbolic_constant#from_level ~config @@ Ok () + let constant_78 + = constant_78#from_level ~config @@ Ok () + let constant_01 + = constant_01#from_level ~config @@ Ok () + let perform_varying_without_by + = perform_varying_without_by#from_level ~config @@ Ok () + let reference_out_of_declaratives + = reference_out_of_declaratives#from_level ~config @@ Warning () + let program_prototypes + = program_prototypes#from_level ~config @@ Ok () + let call_convention_mnemonic + = call_convention_mnemonic#from_level ~config @@ Ok () + let call_convention_linkage + = call_convention_linkage#from_level ~config @@ Ok () + let numeric_value_for_edited_item + = numeric_value_for_edited_item#from_level ~config @@ Ok () + let incorrect_conf_sec_order + = incorrect_conf_sec_order#from_level ~config @@ Ok () + let define_constant_directive + = define_constant_directive#from_level ~config @@ Archaic () + let free_redefines_position + = free_redefines_position#from_level ~config @@ Warning () + let records_mismatch_record_clause + = records_mismatch_record_clause#from_level ~config @@ Warning () + let record_delimiter + = record_delimiter#from_level ~config @@ Ok () + let sequential_delimiters + = sequential_delimiters#from_level ~config @@ Ok () + let record_delim_with_fixed_recs + = record_delim_with_fixed_recs#from_level ~config @@ Ok () + let missing_statement + = missing_statement#from_level ~config @@ Warning () + let missing_period + = missing_period#from_level ~config @@ Warning () + let zero_length_literals + = zero_length_literals#from_level ~config @@ Ok () + let xml_generate_extra_phrases + = xml_generate_extra_phrases#from_level ~config @@ Ok () + let continue_after + = continue_after#from_level ~config @@ Ok () + let goto_entry + = goto_entry#from_level ~config @@ Warning () + let assign_variable + = assign_variable#from_level ~config @@ Ok () + let assign_using_variable + = assign_using_variable#from_level ~config @@ Ok () + let assign_ext_dyn + = assign_ext_dyn#from_level ~config @@ Ok () + let assign_disk_from + = assign_disk_from#from_level ~config @@ Ok () + let vsam_status + = vsam_status#from_level ~config Ignore + let self_call_recursive + = self_call_recursive#from_level ~config @@ Warning () + let record_contains_depending_clause + = record_contains_depending_clause#from_level ~config Unconformable + let picture_l + = picture_l#from_level ~config @@ Ok () +end + +include Default diff --git a/src/lsp/cobol_config/default.mli b/src/lsp/cobol_config/default.mli new file mode 100644 index 000000000..b912ec9f2 --- /dev/null +++ b/src/lsp/cobol_config/default.mli @@ -0,0 +1,15 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module contains all the default configurations. *) +include Types.T diff --git a/src/lsp/cobol_config/dune b/src/lsp/cobol_config/dune new file mode 100644 index 000000000..83040b777 --- /dev/null +++ b/src/lsp/cobol_config/dune @@ -0,0 +1,36 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_config) + (public_name cobol_config) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries pretty ppx_deriving menhirLib cobol_common ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show)) + + ) + +(ocamllex conf_lexer) + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_config)) + +; use field 'dune-trailer' to add more stuff here + +(rule (targets conf_parser_messages.ml) + (deps conf_parser.messages conf_parser.mly) + (action + (with-stdout-to %{targets} + (run menhir --compile-errors %{deps})))) + + +(menhir (modules conf_parser) (flags --inspection --table)) + diff --git a/src/lsp/cobol_config/from_file.ml b/src/lsp/cobol_config/from_file.ml new file mode 100644 index 000000000..45175a09d --- /dev/null +++ b/src/lsp/cobol_config/from_file.ml @@ -0,0 +1,224 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Types +open Options +open Cobol_common.Basics + +module Make + (Diags: Cobol_common.Diagnostics.STATEFUL) + (Conf: sig + include Types.CONFIG + val options: Conf_ast.value StringMap.t + val words: Types.words_spec + val intrinsic_functions: StringSet.t + val system_names: StringSet.t + val registers: StringSet.t + end): T = struct + open Conf + + exception LookupError + + let warn t n v = + Diags.warn "`%s`@ expected@ a@ value@ of@ type@ %s,@ but@ got@ %a;@ \ + resorting@ to@ the@ default@ value." n t Conf_ast.pp_value v + + let not_found n = + Diags.warn "Could@ not@ find@ a@ configuration@ for@ `%s';@ using@ the@ \ + default@ value." n + + let find_any name = + match StringMap.find_opt name options with + | Some (Any v | String v) -> v + | Some (Int i) -> string_of_int i + | Some v -> + warn "any" name v; + raise LookupError + | None -> not_found name; raise LookupError + + let find_bool name = + match StringMap.find_opt name options with + | Some Bool v -> v + | Some v -> + warn "boolean" name v; + raise LookupError + | None -> not_found name; raise LookupError + + let find_int name = + match StringMap.find_opt name options with + | Some Int v -> v + | Some v -> + warn "int" name v; + raise LookupError + | None -> not_found name; raise LookupError + + let find_support name = + match StringMap.find_opt name options with + | Some Support (Normal v| Additional v) -> v + | Some v -> + warn "support" name v; + raise LookupError + | None -> not_found name; raise LookupError + + + let config = config + let dialect = dialect + + (* reserved_words *) + let words = words + let intrinsic_functions = intrinsic_functions + let system_names = system_names + let registers = registers + + + let parse_value finder v default = + try v#from_val ~config (finder v#name) + with LookupError -> default + let parse_int_value = parse_value find_int + let parse_bool_value = parse_value find_bool + let parse_string_value v default = + try v#from_string ~config (find_any v#name) + with LookupError -> default + let parse_support_value v default = + try v#from_ast ~config (find_support v#name) + with LookupError -> default + + (* int values *) + let tab_width = parse_int_value tab_width Default.tab_width + let text_column = parse_int_value text_column Default.text_column + let pic_length = parse_int_value pic_length Default.pic_length + let word_length = parse_int_value word_length Default.word_length + let literal_length = parse_int_value literal_length Default.literal_length + let numeric_literal_length = parse_int_value numeric_literal_length + Default.numeric_literal_length + + (* any values *) + let defaultbyte = parse_string_value defaultbyte Default.defaultbyte + let standard_define = parse_string_value standard_define Default.standard_define + let format = parse_string_value format Default.format + let binary_size = parse_string_value binary_size Default.binary_size + let binary_byteorder = parse_string_value binary_byteorder Default.binary_byteorder + let assign_clause = parse_string_value assign_clause Default.assign_clause + let screen_section_rules = parse_string_value screen_section_rules Default.screen_section_rules + let dpc_in_data = parse_string_value dpc_in_data Default.dpc_in_data + + (* boolean values *) + let filename_mapping = parse_bool_value filename_mapping Default.filename_mapping + let pretty_display = parse_bool_value pretty_display Default.pretty_display + let binary_truncate = parse_bool_value binary_truncate Default.binary_truncate + let complex_odo = parse_bool_value complex_odo Default.complex_odo + let odoslide = parse_bool_value odoslide Default.odoslide + let indirect_redefines = parse_bool_value indirect_redefines Default.indirect_redefines + let relax_syntax_checks = parse_bool_value relax_syntax_checks Default.relax_syntax_checks + let ref_mod_zero_length = parse_bool_value ref_mod_zero_length Default.ref_mod_zero_length + let relax_level_hierarchy = parse_bool_value relax_level_hierarchy Default.relax_level_hierarchy + let select_working = parse_bool_value select_working Default.select_working + let local_implies_recursive = parse_bool_value local_implies_recursive Default.local_implies_recursive + let sticky_linkage = parse_bool_value sticky_linkage Default.sticky_linkage + let move_ibm = parse_bool_value move_ibm Default.move_ibm + let perform_osvs = parse_bool_value perform_osvs Default.perform_osvs + let arithmetic_osvs = parse_bool_value arithmetic_osvs Default.arithmetic_osvs + let hostsign = parse_bool_value hostsign Default.hostsign + let program_name_redefinition = parse_bool_value program_name_redefinition Default.program_name_redefinition + let accept_update = parse_bool_value accept_update Default.accept_update + let accept_auto = parse_bool_value accept_auto Default.accept_auto + let console_is_crt = parse_bool_value console_is_crt Default.console_is_crt + let no_echo_means_secure = parse_bool_value no_echo_means_secure Default.no_echo_means_secure + let line_col_zero_default = parse_bool_value line_col_zero_default Default.line_col_zero_default + let display_special_fig_consts = parse_bool_value display_special_fig_consts Default.display_special_fig_consts + let binary_comp_1 = parse_bool_value binary_comp_1 Default.binary_comp_1 + let numeric_pointer = parse_bool_value numeric_pointer Default.numeric_pointer + let move_non_numeric_lit_to_numeric_is_zero = parse_bool_value move_non_numeric_lit_to_numeric_is_zero Default.move_non_numeric_lit_to_numeric_is_zero + let implicit_assign_dynamic_var = parse_bool_value implicit_assign_dynamic_var Default.implicit_assign_dynamic_var + let device_mnemonics = parse_bool_value device_mnemonics Default.device_mnemonics + let xml_parse_xmlss = parse_bool_value xml_parse_xmlss Default.xml_parse_xmlss + let areacheck = parse_bool_value areacheck Default.areacheck + let ebcdic_symbolic_characters = parse_bool_value ebcdic_symbolic_characters Default.ebcdic_symbolic_characters + + (* support values *) + let comment_paragraphs = parse_support_value comment_paragraphs Default.comment_paragraphs + let safe_partial_replacing_when_src_literal = parse_support_value safe_partial_replacing_when_src_literal Default.safe_partial_replacing_when_src_literal + let control_division = parse_support_value control_division Default.control_division + let memory_size_clause = parse_support_value memory_size_clause Default.memory_size_clause + let multiple_file_tape_clause = parse_support_value multiple_file_tape_clause Default.multiple_file_tape_clause + let label_records_clause = parse_support_value label_records_clause Default.label_records_clause + let value_of_clause = parse_support_value value_of_clause Default.value_of_clause + let data_records_clause = parse_support_value data_records_clause Default.data_records_clause + let top_level_occurs_clause = parse_support_value top_level_occurs_clause Default.top_level_occurs_clause + let same_as_clause = parse_support_value same_as_clause Default.same_as_clause + let type_to_clause = parse_support_value type_to_clause Default.type_to_clause + let usage_type = parse_support_value usage_type Default.usage_type + let synchronized_clause = parse_support_value synchronized_clause Default.synchronized_clause + let sync_left_right = parse_support_value sync_left_right Default.sync_left_right + let special_names_clause = parse_support_value special_names_clause Default.special_names_clause + let goto_statement_without_name = parse_support_value goto_statement_without_name Default.goto_statement_without_name + let stop_literal_statement = parse_support_value stop_literal_statement Default.stop_literal_statement + let stop_identifier_statement = parse_support_value stop_identifier_statement Default.stop_identifier_statement + let stop_error_statement = parse_support_value stop_error_statement Default.stop_error_statement + let debugging_mode = parse_support_value debugging_mode Default.debugging_mode + let use_for_debugging = parse_support_value use_for_debugging Default.use_for_debugging + let padding_character_clause = parse_support_value padding_character_clause Default.padding_character_clause + let next_sentence_phrase = parse_support_value next_sentence_phrase Default.next_sentence_phrase + let listing_statements = parse_support_value listing_statements Default.listing_statements + let title_statement = parse_support_value title_statement Default.title_statement + let entry_statement = parse_support_value entry_statement Default.entry_statement + let move_noninteger_to_alphanumeric = parse_support_value move_noninteger_to_alphanumeric Default.move_noninteger_to_alphanumeric + let move_figurative_constant_to_numeric = parse_support_value move_figurative_constant_to_numeric Default.move_figurative_constant_to_numeric + let move_figurative_space_to_numeric = parse_support_value move_figurative_space_to_numeric Default.move_figurative_space_to_numeric + let move_figurative_quote_to_numeric = parse_support_value move_figurative_quote_to_numeric Default.move_figurative_quote_to_numeric + let odo_without_to = parse_support_value odo_without_to Default.odo_without_to + let section_segments = parse_support_value section_segments Default.section_segments + let alter_statement = parse_support_value alter_statement Default.alter_statement + let call_overflow = parse_support_value call_overflow Default.call_overflow + let numeric_boolean = parse_support_value numeric_boolean Default.numeric_boolean + let hexadecimal_boolean = parse_support_value hexadecimal_boolean Default.hexadecimal_boolean + let national_literals = parse_support_value national_literals Default.national_literals + let hexadecimal_national_literals = parse_support_value hexadecimal_national_literals Default.hexadecimal_national_literals + let national_character_literals = parse_support_value national_character_literals Default.national_character_literals + let hp_octal_literals = parse_support_value hp_octal_literals Default.hp_octal_literals + let acu_literals = parse_support_value acu_literals Default.acu_literals + let word_continuation = parse_support_value word_continuation Default.word_continuation + let not_exception_before_exception = parse_support_value not_exception_before_exception Default.not_exception_before_exception + let accept_display_extensions = parse_support_value accept_display_extensions Default.accept_display_extensions + let larger_redefines = parse_support_value larger_redefines Default.larger_redefines + let symbolic_constant = parse_support_value symbolic_constant Default.symbolic_constant + let constant_78 = parse_support_value constant_78 Default.constant_78 + let constant_01 = parse_support_value constant_01 Default.constant_01 + let perform_varying_without_by = parse_support_value perform_varying_without_by Default.perform_varying_without_by + let reference_out_of_declaratives = parse_support_value reference_out_of_declaratives Default.reference_out_of_declaratives + let program_prototypes = parse_support_value program_prototypes Default.program_prototypes + let call_convention_mnemonic = parse_support_value call_convention_mnemonic Default.call_convention_mnemonic + let call_convention_linkage = parse_support_value call_convention_linkage Default.call_convention_linkage + let numeric_value_for_edited_item = parse_support_value numeric_value_for_edited_item Default.numeric_value_for_edited_item + let incorrect_conf_sec_order = parse_support_value incorrect_conf_sec_order Default.incorrect_conf_sec_order + let define_constant_directive = parse_support_value define_constant_directive Default.define_constant_directive + let free_redefines_position = parse_support_value free_redefines_position Default.free_redefines_position + let records_mismatch_record_clause = parse_support_value records_mismatch_record_clause Default.records_mismatch_record_clause + let record_delimiter = parse_support_value record_delimiter Default.record_delimiter + let sequential_delimiters = parse_support_value sequential_delimiters Default.sequential_delimiters + let record_delim_with_fixed_recs = parse_support_value record_delim_with_fixed_recs Default.record_delim_with_fixed_recs + let missing_statement = parse_support_value missing_statement Default.missing_statement + let missing_period = parse_support_value missing_period Default.missing_period + let zero_length_literals = parse_support_value zero_length_literals Default.zero_length_literals + let xml_generate_extra_phrases = parse_support_value xml_generate_extra_phrases Default.xml_generate_extra_phrases + let continue_after = parse_support_value continue_after Default.continue_after + let goto_entry = parse_support_value goto_entry Default.goto_entry + let assign_variable = parse_support_value assign_variable Default.assign_variable + let assign_using_variable = parse_support_value assign_using_variable Default.assign_using_variable + let assign_ext_dyn = parse_support_value assign_ext_dyn Default.assign_ext_dyn + let assign_disk_from = parse_support_value assign_disk_from Default.assign_disk_from + let vsam_status = parse_support_value vsam_status Default.vsam_status + let self_call_recursive = parse_support_value self_call_recursive Default.self_call_recursive + let record_contains_depending_clause = parse_support_value record_contains_depending_clause Default.record_contains_depending_clause + let picture_l = parse_support_value picture_l Default.picture_l +end diff --git a/src/lsp/cobol_config/from_file.mli b/src/lsp/cobol_config/from_file.mli new file mode 100644 index 000000000..1a8660b43 --- /dev/null +++ b/src/lsp/cobol_config/from_file.mli @@ -0,0 +1,26 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Basics + +(** This functor is used to build a config ({! Types.T}) module from a file *) +module Make + (Diags: Cobol_common.Diagnostics.STATEFUL) + (Conf: sig + include Types.CONFIG + val options: Conf_ast.value StringMap.t + val words: Types.words_spec + val intrinsic_functions: StringSet.t + val system_names: StringSet.t + val registers: StringSet.t + end): Types.T diff --git a/src/lsp/cobol_config/index.mld b/src/lsp/cobol_config/index.mld new file mode 100644 index 000000000..7836e4fd3 --- /dev/null +++ b/src/lsp/cobol_config/index.mld @@ -0,0 +1,10 @@ +{1 Library cobol_config} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package is used to parse configuration files and generate the corresponding configuration to +use inside [superbol]. + +The entry point of this library is the module: {!Cobol_config}. + diff --git a/src/lsp/cobol_config/options.ml b/src/lsp/cobol_config/options.ml new file mode 100644 index 000000000..21b047dd3 --- /dev/null +++ b/src/lsp/cobol_config/options.ml @@ -0,0 +1,645 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Types + +(** This module contains all the option available *) + +(* int options *) +let tab_width: int value = + Value.int ~name:"tab-width" + "Number@ of@ spaces@ that@ are@ assumed@ for@ tabs." + +let text_column: int value = + Value.int ~name:"text-column" + "Right@ margin@ column@ number@ for@ fixed-form@ reference-format." + +let pic_length: int value = + Value.int ~name:"pic-length" + "Maximum@ size@ of@ a@ picture@ string." + +let word_length: int value = + Value.int ~name:"word-length" + "Maximum@ word-length @ for@ COBOL@ (=@ programmer@ defined)@ words." + +let literal_length: int value = + Value.int ~name:"literal-length" + "Maximum@ literal@ size@ in@ general." + +let numeric_literal_length: int value = + Value.int ~name:"numeric-literal-length" + "Maximum@ numeric@ literal@ size." + +(* any options *) +let defaultbyte: defaultbyte value = + let kind = object + inherit [_] kind ~name:"defaultbyte" + method parse s: defaultbyte = + match s with + | "init" -> Init + | "none" -> None + | _ -> + if String.length s = 1 then + Char (s.[0]) + else + begin match int_of_string_opt s with + | Some i when i >= 0 && i <= 255 -> + Char (Char.chr i) + | _ -> invalid_arg s + end + end + in + Value.def ~name:"defaultbyte" ~kind + "Default@ initialization@ for@ field@ without@ Value." + +let standard_define: standard value = + let kind = object + inherit [_] kind ~name:"standard-define" + method parse s: standard = + match int_of_string_opt s with + | Some i when i >= 0 && i <= 9 -> + begin match i with + | 0 -> GnuCOBOL + | 1 -> MicroFocus + | 2 -> IBM + | 3 -> MVS + | 4 -> BS2000 + | 5 -> ACU + | 6 -> RM + | 7 -> STD85 + | 8 -> STD2002 + | 9 -> STD2014 + | _ -> assert false (*unreachable*) + end + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"standard-define" + "Used@ standard" + +let format: source_format_spec value = + let kind = object + inherit [_] kind ~name:"format" + method parse s: source_format_spec = + match String.lowercase_ascii s with + | "fixed" -> SF SFFixed + | "free" -> SF SFFree + | "cobol85" -> SF SFFixed + | "variable" -> SF SFVariable + | "xopen" -> SF SFXOpen + | "xcard" -> SF SFxCard + | "terminal" -> SF SFTrm + | "cobolx" -> SF SFCOBOLX + | "auto" -> Auto + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"format" + "Default@ reference@ format." + +let binary_size: binary_size value = + let kind = object + inherit [_] kind ~name:"binary-size" + method parse s: binary_size = + match s with + | "2-4-8" -> B_2_4_8 + | "1-2-4-8" -> B_1_2_4_8 + | "1--8" -> B_1__8 + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"binary-size" + ~short:"binary@ byte@ size" + "Binary@ byte@ size@ -@ defines@ the@ allocated@ bytes@ according@ to@ PIC." + +let binary_byteorder: binary_byteorder value = + let kind = object + inherit [_] kind ~name:"binary-byteorder" + method parse s: binary_byteorder = + match String.lowercase_ascii s with + | "native" -> Native + | "big-endian" -> Big_endian + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"binary-byteorder" + "Binary@ byte@ order." + +let assign_clause: assign_clause value = + let kind = object + inherit [_] kind ~name:"assign-clause" + method parse s: assign_clause = + match String.lowercase_ascii s with + | "dynamic" -> Dynamic + | "external" -> External + | "ibm" -> IBM + | "mf" -> MF + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"assign-clause" + ~short:"how@ to@ interpret@ 'ASSIGN@ word'" + "How@ to@ interpret@ 'ASSIGN@ word':@ as@ 'ASSIGN@ EXTERNAL@ word'@ or@ 'ASSIGN@ DYNAMIC@ word'" + +let screen_section_rules: screen_section_rules value = + let kind = object + inherit [_] kind ~name:"screen-section-rules" + method parse s: screen_section_rules = + match String.lowercase_ascii s with + | "acu" -> ACU + | "gc" -> GC + | "mf" -> MF + | "rm" -> RM + | "std" -> STD + | "xopen" -> XOPEN + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"screen-section-rules" + "Which@ compiler's@ rules@ to@ apply@ to@ SCREEN@ SECTION@ item@ clauses." + +let dpc_in_data: dpc_in_data value = + let kind = object + inherit [_] kind ~name:"dpc-in-data" + method parse s: dpc_in_data = + match String.lowercase_ascii s with + | "none" -> None + | "xml" -> XML + | "json" -> Json + | "all" -> All + | _ -> invalid_arg s + end in + Value.def ~kind ~name:"dpc-in-data" + "Wether@ DECIMAL@ POINT@ IS@ COMMA@ has@ effect@ in@ XML/JSON@ GENERATE." + +(* boolean options *) +let filename_mapping: bool value = + Value.bool ~name:"filename-mapping" + "resolve@ file@ names@ at@ run@ time@ using@ environment@ variables" + +let pretty_display: bool value = + Value.bool ~name:"pretty-display" + "alternate@ formatting@ of@ numeric@ fields" + +let binary_truncate: bool value = + Value.bool ~name:"binary-truncate" + "numeric@ truncation@ according@ to@ ANSI" + +let complex_odo: bool value = + Value.bool ~name:"complex-odo" + "allow@ non-standard@ OCCURS@ DEPENDING@ ON@ syntax" + +let odoslide: bool value = + Value.bool ~name:"odoslide" + "adjust@ items@ following@ OCCURS@ DEPENDING@ (implies@ complex-odo)" + +let indirect_redefines: bool value = + Value.bool ~name:"indirect-redefines" + "allow@ REDEFINES@ to@ other@ than@ last@ equal@ level@ number" + +let relax_syntax_checks: bool value = + Value.bool ~name:"relax-syntax-checks" + "allow@ certain@ syntax@ variation@ (e.g.@ REDEFINES@ position)" + +let ref_mod_zero_length: bool value = + Value.bool ~name:"ref-mod-zero-length" + ~short:"allow@ zero@ length@ reference-modification" + "allow@ zero@ length@ reference-modification@ (only@ changed@ with@ EC-BOUND-REF-MOD@ active)" + +let relax_level_hierarchy: bool value = + Value.bool ~name:"relax-level-hierarchy" + "allow@ non-matching@ level@ numbers" + +let select_working: bool value = + Value.bool ~name:"select-working" + "require@ ASSING@ UNSING@ items@ to@ be@ in@ WORKING-STORAGE" + +let local_implies_recursive: bool value = + Value.bool ~name:"local-implies-recursive" + "LOCAL-STORAGE@ SECTION@ implies@ RECURSIVE@ attribute" + +let sticky_linkage: bool value = + Value.bool ~name:"sticky-linkage" + "LINKAGE@ SECTION@ items@ remain@ allocated@ between@ invocations" + +let move_ibm: bool value = + Value.bool ~name:"move-ibm" + "MOVE@ operates@ as@ on@ IBM@ (left@ to@ right,@ byte@ by@ byte)" + +let perform_osvs: bool value = + Value.bool ~name:"perform-osvs" + "exit@ point@ of@ any@ currently@ executing@ perfom@ is@ recognized@ if@ reached" + +let arithmetic_osvs: bool value = + Value.bool ~name:"arithmetic-osvs" + "limit@ precision@ in@ intermediate@ result@ to@ precision@ of@ final@ result@ (less@ accurate)" + +let hostsign: bool value = + Value.bool ~name:"hostsign" + "allow@ hexadecimal@ values@ 'F' for@ NUMERIC@ test@ of@ signed@ PACKED@ DECIMAL@ field" + +let program_name_redefinition: bool value = + Value.bool ~name:"program-name-redefinition" + "program@ names@ dont't@ lead@ to@ reserved@ identifier" + +let accept_update: bool value = + Value.bool ~name:"accept-update" + "set@ WITH@ UPDATE@ clause@ as@ default@ for@ ACCEPT@ dest-item,@ instead@ of@ WITH@ NO@ UPDATE" + +let accept_auto: bool value = + Value.bool ~name:"accept-auto" + "set@ WITH@ AUTO@ clause@ as@ default@ for@ ACCEPT@ dest-item,@ instead@ of@ WIHT@ TAB" + +let console_is_crt: bool value = + Value.bool ~name:"console-is-crt" + "assume@ CONSOLE@ IS@ CRT@ if@ not@ set@ otherwise" + +let no_echo_means_secure: bool value = + Value.bool ~name:"no-echo-means-secure" + "NO-ECHO@ hides@ input@ with@ asterisks@ like@ SECURE" + +let line_col_zero_default: bool value = + Value.bool ~name:"line-col-zero-default" + ~short:"assume@ a@ field@ DISPLAY@ starts@ at@ LINE@ 0@ COL@ 0" + "assume@ a@ field@ DISPLAY@ starts@ at@ LINE@ 0@ COL@ 0@ (i.e.@ at@ the@ cursor),@ not LINE@ 1@ COL@ 1" + +let display_special_fig_consts: bool value = + Value.bool ~name:"display-special-fig-consts" + "special@ behaviour@ of@ DISPLAY@ SPACE/ALL@ X'01'/ALL@ X'02'/ALL X'07'" + +let binary_comp_1: bool value = + Value.bool ~name:"binary-comp-1" + "COMP-1@ is@ a@ 16-bit@ signed@ integer" + +let numeric_pointer: bool value = + Value.bool ~name:"numeric-pointer" + "POINTER@ is@ 64-bit@ unsigned@ integer" + +let move_non_numeric_lit_to_numeric_is_zero: bool value = + Value.bool ~name:"move-non-numeric-lit-to-numeric-is-zero" + "imply@ zero@ in@ move@ of@ non-numeric@ literal@ to@ numeric@ items" + +let implicit_assign_dynamic_var: bool value = + Value.bool ~name:"implicit-assign-dynamic-var" + "implicitly@ define@ a@ variable@ if@ an@ ASSIGN@ DYNAMIC@ does@ not@ match@ any@ data@ item" + +let device_mnemonics: bool value = + Value.bool ~name:"device-mnemonics" + "specifying@ device@ by@ mnemonic" + +let xml_parse_xmlss: bool value = + Value.bool ~name:"xml-parse-xmlss" + "XML@ PARSE@ XMLSS" + +let areacheck: bool value = + Value.bool ~name:"areacheck" + ~short:"check@ contents@ of@ Area@ A@" + "check@ contents@ of@ Area@ A@ (when@ reference@ format@ supports@ Area@ A enforcement)@\n\ + @[@[enabled@ checks@ include:@]@\n\ + @[*@ division,@ section,@ paragraph@ names,@ level@ indicators@ (FD,@ SD,@ RD,@ \ + and@ CD),@\n@[and@ toplevel@ numbers@ (01@ and@ 77)@ must@ start@ in@ Area@ A;@]@]@\n\ + @[*@ statements@ must@ not@ start@ in@ Area A; and@]@\n\ + @[*@ separator@ periods@ must@ not@ be@ within@ Area@ A@]@]" + +let ebcdic_symbolic_characters: bool value = + Value.bool ~name:"ebcdic-symbolic-characters" + ~short:"EBCDIC symbolic characters" + "EBCDIC symbolic characters in literals (\" \"135,151,151\"bar\"195, \ + 194\"Z\" for \" foobarBAZ\")" + +(* support options *) +(*NOTE: GnuCOBOL option name is "partial-replace-when-literal-src"*) +let safe_partial_replacing_when_src_literal: [`Safe | `Unsafe] feature = + let feature_kind = object + inherit [_] FEATURE.feature_kind ~name:"safety support" + method parse s : [`Safe | `Unsafe] FEATURE.support_level = + match String.lowercase_ascii s with + | "ok" -> FEATURE.Ok `Safe + | "warning" -> Warning `Safe + | "archaic" -> Archaic `Safe + | "obsolete" -> Obsolete `Safe + | "skip" -> Ok `Unsafe (* special semantics *) + | "ignore" -> Ignore + | "error" -> Error + | "unconformable" -> Unconformable + | _ as s -> raise @@ Invalid_argument s + method from_ast s: [`Safe | `Unsafe] FEATURE.support_level = + match s with + | Conf_ast.Ok -> FEATURE.Ok `Safe + | Warning -> Warning `Safe + | Archaic -> Archaic `Safe + | Obsolete -> Obsolete `Safe + | Skip -> Ok `Unsafe + | Ignore -> Ignore + | Error -> Error + | Unconformable -> Unconformable + end in + FEATURE.def ~feature_kind ~name:"partial-replace-when-literal-src" + ~short:"partial@ replacing@ with@ literal@ source@ operands" + "Enable@ partial@ replacings@ (COPY...REPLACING/REPLACE@ \ + LEADING/TRAILING)@ with@ literal@ source@ operands, and@ apply@ them@ \ + even@ when@ they@ replace@ with@ spaces@ only." + +let comment_paragraphs: unit feature = + FEATURE.unit ~name:"comment-paragraphs" + ~short:"comment@ paragraph@ in@ IDENTIFICATION@ DIVISION" + "Comment@ paragraphs@ in@ IDENTIFICATION@ DIVISION@ (AUTHOR,@ \ + DATE-WRITTEN,@ ...)." + +let control_division: unit feature = + FEATURE.unit ~name:"control-division" + "CONTROL@ DIVISION" + +let memory_size_clause: unit feature = + FEATURE.unit ~name:"memory-size-clause" + "MEMORY-SIZE@ clause" + +let multiple_file_tape_clause: unit feature = + FEATURE.unit ~name:"multiple-file-tape-clause" + "MULTIPLE-FILE-TAPE@ clause" + +let label_records_clause: unit feature = + FEATURE.unit ~name:"label-records-clause" + "LABEL_RECORDS@ clause" + +let value_of_clause: unit feature = + FEATURE.unit ~name:"value-of-clause" + "Value-OF@ clause" + +let data_records_clause: unit feature = + FEATURE.unit ~name:"data-records-clause" + "DATA-RECORDS@ clause" + +let top_level_occurs_clause: unit feature = + FEATURE.unit ~name:"top-level-occurs-clause" + "OCCURS@ clause@ on@ top-level" + +let same_as_clause: unit feature = + FEATURE.unit ~name:"same-as-clause" + "SAME@ AS@ clause" + +let type_to_clause: unit feature = + FEATURE.unit ~name:"type-to-clause" + "TYPE@ TO@ clause" + +let usage_type: unit feature = + FEATURE.unit ~name:"usage-type" + "USAGE@ type-name" + +let synchronized_clause: unit feature = + FEATURE.unit ~name:"synchronized-clause" + "SYNCHRONIZED@ clause" + +let sync_left_right: unit feature = + FEATURE.unit ~name:"sync-left-right" + "LEFT/RIGHT@ phrases@ in@ SYNCHRONIZED@ clause" + +let special_names_clause: unit feature = + FEATURE.unit ~name:"special-names-clause" + "SPECIAL-NAMES@ clause" + +let goto_statement_without_name: unit feature = + FEATURE.unit ~name:"goto-statement-without-name" + "GO@ TO@ statement without name" + +let stop_literal_statement: unit feature = + FEATURE.unit ~name:"stop-literal-statement" + "STOP-literal@ statement" + +let stop_identifier_statement: unit feature = + FEATURE.unit ~name:"stop-identifier-statement" + "STOP-identifier@ statement" + +let stop_error_statement: unit feature = + FEATURE.unit ~name:"stop-error-statement" + "STOP-error@ statement" + +let debugging_mode: unit feature = + FEATURE.unit ~name:"debugging-mode" + "DEBUGGING@ MODE@ and@ debugging@ indicator" + +let use_for_debugging: unit feature = + FEATURE.unit ~name:"use-for-debugging" + "USE@ FOR@ DEBUGGING" + +let padding_character_clause: unit feature = + FEATURE.unit ~name:"padding-character-clause" + "PADDING@ CHARACTER@ clause" + +let next_sentence_phrase: unit feature = + FEATURE.unit ~name:"next-sentence-phrase" + "NEXT@ SENTENCE@ phrase" + +let listing_statements: unit feature = + FEATURE.unit ~name:"listing-statements" + "listing-directive@ statements@ EJECT,@ SKIP1,@ SKIP2,@ SKIP3" + +let title_statement: unit feature = + FEATURE.unit ~name:"title-statement" + "listing-directive@ statement@ TITLE" + +let entry_statement: unit feature = + FEATURE.unit ~name:"entry-statement" + "ENTRY@ statement" + +let move_noninteger_to_alphanumeric: unit feature = + FEATURE.unit ~name:"move-noninteger-to-alphanumeric" + "move@ noninteger@ to@ alphanumeric" + +let move_figurative_constant_to_numeric: unit feature = + FEATURE.unit ~name:"move-figurative-constant-to-numeric" + "move@ figurative@ constants@ to@ numeric" + +let move_figurative_space_to_numeric: unit feature = + FEATURE.unit ~name:"move-figurative-space-to-numeric" + "move@ figurative@ constant@ SPACE@ to@ numeric" + +let move_figurative_quote_to_numeric: unit feature = + FEATURE.unit ~name:"move-figurative-quote-to-numeric" + "move@ figurative@ constant@ QUOTE@ to@ numeric" + +let odo_without_to: unit feature = + FEATURE.unit ~name:"odo-without-to" + "OCCURS@ DEPENDING@ ON@ without@ to" + +let section_segments: unit feature = + FEATURE.unit ~name:"section-segments" + "section@ segments" + +let alter_statement: unit feature = + FEATURE.unit ~name:"alter-statement" + "ALTER@ statement" + +let call_overflow: unit feature = + FEATURE.unit ~name:"call-overflow" + "OVERFLOW@ clause@ for@ CALL" + +let numeric_boolean: unit feature = + FEATURE.unit ~name:"numeric-boolean" + "boolean@ literal@ (B'1010')" + +let hexadecimal_boolean: unit feature = + FEATURE.unit ~name:"hexadecimal-boolean" + "hexadecimal-boolean@ literal@ (BX'A')" + +let national_literals: unit feature = + FEATURE.unit ~name:"national-literals" + "national@ literals@ (N'UTF-16 string')" + +let hexadecimal_national_literals: unit feature = + FEATURE.unit ~name:"hexadecimal-national-literals" + "hexadecimal-national@ literals@ (NX'265E')" + +let national_character_literals: unit feature = + FEATURE.unit ~name:"national-character-literals" + "non-standard@ national@ literals@ (NC'UTF-16 string')" + +let hp_octal_literals: unit feature = + FEATURE.unit ~name:"hp-octal-literals" + "HP@ COBOL@ octal@ literals (%%377)" + +let acu_literals: unit feature = + FEATURE.unit ~name:"acu-literals" + "ACUCOBOL-G@ literals@ (#B #O #H #X)" + +let word_continuation: unit feature = + FEATURE.unit ~name:"word-continuation" + "continuation@ of@ COBOL@ words" + +let not_exception_before_exception: unit feature = + FEATURE.unit ~name:"not-exception-before-exception" + "NOT@ ON@ EXCEPTION@ before@ ON@ EXCEPTION" + +let accept_display_extensions: unit feature = + FEATURE.unit ~name:"accept-display-extensions" + "extensions@ to@ ACCEPT@ and@ DISPLAY" + +let larger_redefines: unit feature = + FEATURE.unit ~name:"larger-redefines" + "allow@ larger@ REDEFINES@ items" + +let symbolic_constant: unit feature = + FEATURE.unit ~name:"symbolic-constant" + "constants@ defined@ in@ SPECIAL-NAMES" + +let constant_78: unit feature = + FEATURE.unit ~name:"constant-78" + ~short:"constant@ with@ level@ 78@ item" + "constant@ with@ level@ 78@ item@ (note:@ has@ left@ to@ right@ precedence@ in@ expressions)" + +let constant_01: unit feature = + FEATURE.unit ~name:"constant-01" + "constant@ wiht@ level@ 01@ CONSTANT@ AS/FROM@ item (COBOL@ 2002+)" + +let perform_varying_without_by: unit feature = + FEATURE.unit ~name:"perform-varying-without-by" + "PERFORM@ VARYING@ without@ BY@ phrase@ (implies@ BY@ 1)" + +let reference_out_of_declaratives: unit feature = + FEATURE.unit ~name:"reference-out-of-declaratives" + "references@ to@ sections@ not@ in@ DECLARATIVES@ from@ within@ DECLARATIVES" + +let program_prototypes: unit feature = + FEATURE.unit ~name:"program-prototypes" + "CALL/CANCEL@ with@ program-prototype-name" + +let call_convention_mnemonic: unit feature = + FEATURE.unit ~name:"call-convention-mnemonic" + "specifying@ call-convention@ by@ mnemonic" + +let call_convention_linkage: unit feature = + FEATURE.unit ~name:"call-convention-linkage" + "specifying@ call-convention@ by@ WITH@ ...@ LINKAGE" + +let numeric_value_for_edited_item: unit feature = + FEATURE.unit ~name:"numeric-value-for-edited-item" + "numeric@ literals@ in@ Value@ clause@ of@ numeric-edited@ items" + +let incorrect_conf_sec_order: unit feature = + FEATURE.unit ~name:"incorrect-conf-sec-order" + "incorrect@ order@ of@ CONFIGURATION@ SECTION@ paragraphs@ (OpenCOBOL/GnuCOBOL@ extension)" + +let define_constant_directive: unit feature = + FEATURE.unit ~name:"define-constant-directive" + "allow@ >>@ DEFINE@ CONSTANT@ var@ AS@ literal@ (OpenCOBOL/GnuCOBOL@ extension)" + +let free_redefines_position: unit feature = + FEATURE.unit ~name:"free-redefines-position" + "REDEFINES@ caluse@ not@ follwing@ entry-name@ in@ defintion" + +let records_mismatch_record_clause: unit feature = + FEATURE.unit ~name:"records-mismatch-record-clause" + "record@ sizes@ does@ not@ match@ RECORD@ clause" + +let record_delimiter: unit feature = + FEATURE.unit ~name:"record-delimiter" + "RECORD@ DELIMITER@ clause" + +let sequential_delimiters: unit feature = + FEATURE.unit ~name:"sequential-delimiters" + "BINARY-SEQUENTIAL@ and @ LINE-SEQUENTIAL@ phrases@ in@ RECORD@ DELIMITER" + +let record_delim_with_fixed_recs: unit feature = + FEATURE.unit ~name:"record-delim-with-fixed-recs" + "RECORD@ DELIMITER@ clause@ on@ file@ with@ fixed-length@ records" + +let missing_statement: unit feature = + FEATURE.unit ~name:"missing-statement" + "missing@ statement@ (e.g.@ empty@ IF/PERFORM)" + +let missing_period: unit feature = + FEATURE.unit ~name:"missing-period" + ~short:"missing@ period@ in@ PROCEDURE@ DIVISION" + "missing@ period@ in@ PROCEDURE@ DIVISION@ (when@ reference@ format@ supports@ Area@ A@ enforcement)" + +let zero_length_literals: unit feature = + FEATURE.unit ~name:"zero-length-literals" + "zero-length@ literals,@ e.g.@ ''@ and@ \"\"" + +let xml_generate_extra_phrases: unit feature = + FEATURE.unit ~name:"xml-generate-extra-phrases" + "XML@ GENERATE's@ phrases@ other@ thant@ COUNT@ IN" + +let continue_after: unit feature = + FEATURE.unit ~name:"continue-after" + "AFTER@ phrase@ in@ CONTINUE@ statement" + +let goto_entry: unit feature = + FEATURE.unit ~name:"goto-entry" + "ENTRY@ FOR@ GO@ TO@ and@ GO@ TO@ ENTRY@ statements" + +let assign_variable: unit feature = + FEATURE.unit ~name:"assign-variable" + "ASSIGN@ [TO]@ variable@ in@ SELECT" + +let assign_using_variable: unit feature = + FEATURE.unit ~name:"assign-using-variable" + "ASSIGN@ USING/VARYING variable@ in@ SELECT" + +let assign_ext_dyn: unit feature = + FEATURE.unit ~name:"assign-ext-dyn" + "ASSIGN@ EXTERNAL/DYNAMIC@ in@ SELECT" + +let assign_disk_from: unit feature = + FEATURE.unit ~name:"assign-disk-from" + "ASSIGN@ DISK@ FROM@ variable@ in@ SELECT" + +let vsam_status: unit feature = + FEATURE.unit ~name:"vsam-status" + "VSAM@ status@ in@ FILE@ STATUS" + +let self_call_recursive: unit feature = + FEATURE.unit ~name:"self-call-recursive" + "CALL@ to@ own@ PROGRAM-ID@ implies@ RECURSIVE@ attribute" + +let record_contains_depending_clause: unit feature = + FEATURE.unit ~name:"record-contains-depending-clause" + "DEPENDING@ clause@ in@ RECORD@ CONTAINS" + +let picture_l: unit feature = + FEATURE.unit ~name:"picture-l" + "PICTURE@ string@ with@ 'L'@ character" diff --git a/src/lsp/cobol_config/options.mli b/src/lsp/cobol_config/options.mli new file mode 100644 index 000000000..bea4fb03e --- /dev/null +++ b/src/lsp/cobol_config/options.mli @@ -0,0 +1,258 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Definition for all options *) +open Types + +val tab_width: int value + +val text_column: int value + +val pic_length: int value + +val word_length: int value + +val literal_length: int value + +val numeric_literal_length: int value + +(* any options *) +val defaultbyte: defaultbyte value + +val standard_define: standard value + +val format: source_format_spec value + +val binary_size: binary_size value + +val binary_byteorder: binary_byteorder value + +val assign_clause: assign_clause value + +val screen_section_rules: screen_section_rules value + +val dpc_in_data: dpc_in_data value + +(* boolean options *) +val filename_mapping: bool value + +val pretty_display: bool value + +val binary_truncate: bool value + +val complex_odo: bool value + +val odoslide: bool value + +val indirect_redefines: bool value + +val relax_syntax_checks: bool value + +val ref_mod_zero_length: bool value + +val relax_level_hierarchy: bool value + +val select_working: bool value + +val local_implies_recursive: bool value + +val sticky_linkage: bool value + +val move_ibm: bool value + +val perform_osvs: bool value + +val arithmetic_osvs: bool value + +val hostsign: bool value + +val program_name_redefinition: bool value + +val accept_update: bool value + +val accept_auto: bool value + +val console_is_crt: bool value + +val no_echo_means_secure: bool value + +val line_col_zero_default: bool value + +val display_special_fig_consts: bool value + +val binary_comp_1: bool value + +val numeric_pointer: bool value + +val move_non_numeric_lit_to_numeric_is_zero: bool value + +val implicit_assign_dynamic_var: bool value + +val device_mnemonics: bool value + +val xml_parse_xmlss: bool value + +val areacheck: bool value + +val ebcdic_symbolic_characters: bool value + +(* support options *) +val safe_partial_replacing_when_src_literal: [`Safe | `Unsafe] feature + +val comment_paragraphs: unit feature + +val control_division: unit feature + +val memory_size_clause: unit feature + +val multiple_file_tape_clause: unit feature + +val label_records_clause: unit feature + +val value_of_clause: unit feature + +val data_records_clause: unit feature + +val top_level_occurs_clause: unit feature + +val same_as_clause: unit feature + +val type_to_clause: unit feature + +val usage_type: unit feature + +val synchronized_clause: unit feature + +val sync_left_right: unit feature + +val special_names_clause: unit feature + +val goto_statement_without_name: unit feature + +val stop_literal_statement: unit feature + +val stop_identifier_statement: unit feature + +val stop_error_statement: unit feature + +val debugging_mode: unit feature + +val use_for_debugging: unit feature + +val padding_character_clause: unit feature + +val next_sentence_phrase: unit feature + +val listing_statements: unit feature + +val title_statement: unit feature + +val entry_statement: unit feature + +val move_noninteger_to_alphanumeric: unit feature + +val move_figurative_constant_to_numeric: unit feature + +val move_figurative_space_to_numeric: unit feature + +val move_figurative_quote_to_numeric: unit feature + +val odo_without_to: unit feature + +val section_segments: unit feature + +val alter_statement: unit feature + +val call_overflow: unit feature + +val numeric_boolean: unit feature + +val hexadecimal_boolean: unit feature + +val national_literals: unit feature + +val hexadecimal_national_literals: unit feature + +val national_character_literals: unit feature + +val hp_octal_literals: unit feature + +val acu_literals: unit feature + +val word_continuation: unit feature + +val not_exception_before_exception: unit feature + +val accept_display_extensions: unit feature + +val larger_redefines: unit feature + +val symbolic_constant: unit feature + +val constant_78: unit feature + +val constant_01: unit feature + +val perform_varying_without_by: unit feature + +val reference_out_of_declaratives: unit feature + +val program_prototypes: unit feature + +val call_convention_mnemonic: unit feature + +val call_convention_linkage: unit feature + +val numeric_value_for_edited_item: unit feature + +val incorrect_conf_sec_order: unit feature + +val define_constant_directive: unit feature + +val free_redefines_position: unit feature + +val records_mismatch_record_clause: unit feature + +val record_delimiter: unit feature + +val sequential_delimiters: unit feature + +val record_delim_with_fixed_recs: unit feature + +val missing_statement: unit feature + +val missing_period: unit feature + +val zero_length_literals: unit feature + +val xml_generate_extra_phrases: unit feature + +val continue_after: unit feature + +val goto_entry: unit feature + +val assign_variable: unit feature + +val assign_using_variable: unit feature + +val assign_ext_dyn: unit feature + +val assign_disk_from: unit feature + +val vsam_status: unit feature + +val self_call_recursive: unit feature + +val record_contains_depending_clause: unit feature + +val picture_l: unit feature diff --git a/src/lsp/cobol_config/package.toml b/src/lsp/cobol_config/package.toml new file mode 100644 index 000000000..848370474 --- /dev/null +++ b/src/lsp/cobol_config/package.toml @@ -0,0 +1,89 @@ + +# name of package +name = "cobol_config" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +generators = ["ocamllex"] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show" + +# files to skip while updating at package level +skip = ["main.ml", "index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_common = "version" +ppx_deriving = ">=5.2.1" +pretty = "version" +[dependencies.menhir] +libname = "menhirLib" +version = ">=1.2" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +dune-trailer = """ + +(rule (targets conf_parser_messages.ml) + (deps conf_parser.messages conf_parser.mly) + (action + (with-stdout-to %{targets} + (run menhir --compile-errors %{deps})))) + + +(menhir (modules conf_parser) (flags --inspection --table)) +""" diff --git a/src/lsp/cobol_config/reserved_words.ml b/src/lsp/cobol_config/reserved_words.ml new file mode 100644 index 000000000..d20cc3f1e --- /dev/null +++ b/src/lsp/cobol_config/reserved_words.ml @@ -0,0 +1,1676 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Basics + +(* Please, use `Word` module to access these words *) + +(** The list of all default reserved words. *) +let reserved_words = + (* /!\ There's duplication between this list and the mapping of keywords to + tokens in `Cobol_parser.Keywords`. + + TODO: Try to avoid this. The association seems to fit well in + `Cobol_parser', yet it depends on `Cobol_config`. Putting the actual + "all-dialect" config and other config values in a library `superbol_config` + might be suitable. *) + [ "3-D"; + "ABSENT"; + "ACCEPT"; + "ACCESS"; + "ACTION"; + "ACTIVATING"; + "ACTIVE-CLASS"; + "ACTIVE-X"; + "ACTUAL"; + "ADD"; + "ADDRESS"; + "ADJUSTABLE-COLUMNS"; + "ADVANCING"; + "AFTER"; + "ALIGNMENT"; + "ALIGNED"; + "ALL"; + "ALLOCATE"; + "ALLOWING"; + "ALPHABET"; + "ALPHABETIC"; + "ALPHABETIC-LOWER"; + "ALPHABETIC-UPPER"; + "ALPHANUMERIC"; + "ALPHANUMERIC-EDITED"; + "ALSO"; + "ALTER"; + "ALTERNATE"; + "AND"; + "ANY"; + "ANYCASE"; + "ANUM"; + "APPLY"; + "ARE"; + "AREA"; + "AREAS"; + "ARGUMENT-NUMBER"; + "ARGUMENT-VALUE"; + "ARITHMETIC"; + "AS"; + "ASCENDING"; + "ASCII"; + "ASSIGN"; + "AT"; + "ATTRIBUTE"; + "ATTRIBUTES"; + "AUTHOR"; + "AUTO"; + "AUTO-DECIMAL"; + "AUTO-SPIN"; + "AUTOMATIC"; + "AWAY-FROM-ZERO"; + "B-AND"; + "B-NOT"; + "B-OR"; + "B-XOR"; + "B-SHIFT-L"; + "B-SHIFT-LC"; + "B-SHIFT-R"; + "B-SHIFT-RC"; + "BACKGROUND-COLOR"; + "BACKGROUND-HIGH"; + "BACKGROUND-LOW"; + "BACKGROUND-STANDARD"; + "BACKWARD"; + "BAR"; + "BASED"; + "BEFORE"; + "BELL"; + "BINARY"; + "BINARY-C-LONG"; + "BINARY-CHAR"; + "BINARY-DOUBLE"; + "BINARY-LONG"; + "BINARY-SEQUENTIAL"; + "BINARY-SHORT"; + "BIT"; + "BITMAP"; + "BITMAP-END"; + "BITMAP-HANDLE"; + "BITMAP-NUMBER"; + "BITMAP-START"; + "BITMAP-TIMER"; + "BITMAP-TRAILING"; + "BITMAP-TRANSPARENT-COLOR"; + "BITMAP-WIDTH"; + "BLANK"; + "BLINK"; + "BLOCK"; + "BOOLEAN"; + "BOTTOM"; + "BOX"; + "BOXED"; + "BULK-ADDITION"; + "BUSY"; + "BUTTONS"; + "BY"; + "BYTE"; + "BYTES"; + "BYTE-LENGTH"; + "C"; + "CALENDAR-FONT"; + "CALL"; + "CANCEL"; + "CANCEL-BUTTON"; + "CAPACITY"; + "CARD-PUNCH"; + "CARD-READER"; + "CASSETTE"; + "CCOL"; + "CD"; + "CELL"; + "CELL-COLOR"; + "CELL-DATA"; + "CELL-FONT"; + "CELL-PROTECTION"; + "CENTER"; + "CENTERED"; + "CENTERED-HEADINGS"; + "CENTURY-DATE"; + "CF"; + "CH"; + "CHAIN"; + "CHAINING"; + "CHANGED"; + "CHARACTER"; + "CHARACTERS"; + "CHECK-BOX"; + "CLASS"; + "CLASS-ID"; + "CLASSIFICATION"; + "CLEAR-SELECTION"; + "CLINE"; + "CLINES"; + "CLOSE"; + "COBOL"; + "CODE"; + "CODE-SET"; + "COL"; + "COLLATING"; + "COLOR"; + "COLORS"; + "COLS"; + "COLUMN"; + "COLUMN-COLOR"; + "COLUMN-DIVIDERS"; + "COLUMN-FONT"; + "COLUMN-HEADINGS"; + "COLUMN-PROTECTION"; + "COLUMNS"; + "COMBO-BOX"; + "COMMA"; + "COMMAND-LINE"; + "COMMIT"; + "COMMON"; + "COMMUNICATION"; + "COMP"; + "COMP-0"; + "COMP-1"; + "COMP-2"; + "COMP-3"; + "COMP-4"; + "COMP-5"; + "COMP-6"; + "COMP-N"; + "COMP-X"; + "COMP-9"; + "COMP-10"; + "COMP-15"; + "COMPUTATIONAL"; + "COMPUTATIONAL-0"; + "COMPUTATIONAL-1"; + "COMPUTATIONAL-2"; + "COMPUTATIONAL-3"; + "COMPUTATIONAL-4"; + "COMPUTATIONAL-5"; + "COMPUTATIONAL-6"; + "COMPUTATIONAL-N"; + "COMPUTATIONAL-X"; + "COMPUTE"; + "CONDITION"; + "CONFIGURATION"; + "CONSTANT"; + "CONTAINS"; + "CONTENT"; + "CONTINUE"; + "CONTROL"; + "CONTROLS"; + "CONVERSION"; + "CONVERTING"; + "COPY"; + "COPY-SELECTION"; + "CORE-INDEX"; + "CORR"; + "CORRESPONDING"; + "COUNT"; + "CRT"; + "CRT-UNDER"; + "CSIZE"; + "CURRENCY"; + "CURRENT"; + "CURSOR"; + "CURSOR-COL"; + "CURSOR-COLOR"; + "CURSOR-FRAME-WIDTH"; + "CURSOR-ROW"; + "CURSOR-X"; + "CURSOR-Y"; + "CUSTOM-PRINT-TEMPLATE"; + "CYCLE"; + "CYL-INDEX"; + "CYL-OVERFLOW"; + "DASHED"; + "DATA"; + "DATA-COLUMNS"; + "DATA-POINTER"; + "DATA-TYPES"; + "DATE"; + "DATE-COMPILED"; + "DATE-ENTRY"; + "DATE-MODIFIED"; + "DATE-WRITTEN"; + "DAY"; + "DAY-OF-WEEK"; + "DE"; + "DEBUGGING"; + "DECIMAL-POINT"; + "DECLARATIVES"; + "DEFAULT"; + "DEFAULT-BUTTON"; + "DEFAULT-FONT"; + "DELETE"; + "DELIMITED"; + "DELIMITER"; + "DEPENDING"; + "DESCENDING"; + "DESTINATION"; + "DESTROY"; + "DETAIL"; + "DISABLE"; + "DISC"; + "DISK"; + "DISP"; + "DISPLAY"; + "DISPLAY-1"; + "DISPLAY-COLUMNS"; + "DISPLAY-FORMAT"; + "DIVIDE"; + "DIVIDER-COLOR"; + "DIVIDERS"; + "DIVISION"; + "DOTDASH"; + "DOTTED"; + "DOUBLE"; + "DOWN"; + "DRAG-COLOR"; + "DROP-DOWN"; + "DROP-LIST"; + "DUPLICATES"; + "DYNAMIC"; + "EBCDIC"; + "EC"; + "ECHO"; + "EDITING"; + "EGI"; + "ELEMENT"; + "ELSE"; + "EMI"; + "ENABLE"; + "ENCODING"; + "ENCRYPTION"; + "END"; + "END-ACCEPT"; + "END-ADD"; + "END-CALL"; + "END-CHAIN"; + "END-COLOR"; + "END-COMPUTE"; + "END-DELETE"; + "END-DISPLAY"; + "END-DIVIDE"; + "END-EVALUATE"; + "END-IF"; + "END-JSON"; + "END-MODIFY"; + "END-MULTIPLY"; + "END-OF-PAGE"; + "END-PERFORM"; + "END-READ"; + "END-RECEIVE"; + "END-RETURN"; + "END-REWRITE"; + "END-SEARCH"; + "END-SEND"; + "END-START"; + "END-STRING"; + "END-SUBTRACT"; + "END-UNSTRING"; + "END-WRITE"; + "END-XML"; + "ENGRAVED"; + "ENSURE-VISIBLE"; + "ENTRY"; + "ENTRY-CONVENTION"; + "ENTRY-FIELD"; + "ENTRY-REASON"; + "ENVIRONMENT"; + "ENVIRONMENT-NAME"; + "ENVIRONMENT-VALUE"; + "EO"; + "EOL"; + "EOP"; + "EOS"; + "EQUAL"; + "ERASE"; + "ERROR"; + "ESCAPE"; + "ESCAPE-BUTTON"; + "ESI"; + "EVALUATE"; + "EVENT"; + "EVENT-LIST"; + "EVERY"; + "EXAMINE"; + "EXCEPTION"; + "EXCEPTION-OBJECT"; + "EXCEPTION-VALUE"; + "EXCLUSIVE"; + "EXCLUSIVE-OR"; + "EXHIBIT"; + "EXIT"; + "EXPAND"; + "EXPANDS"; + "EXTEND"; + "EXTENDED-SEARCH"; + "EXTERN"; + "EXTERNAL"; + "EXTERNAL-FORM"; + "F"; + "FACTORY"; + "FALSE"; + "FD"; + "FH--FCD"; + "FH--KEYDEF"; + "FILE"; + "FILE-CONTROL"; + "FILE-ID"; + "FILE-LIMIT"; + "FILE-LIMITS"; + "FILE-NAME"; + "FILE-POS"; + "FILL-COLOR"; + "FILL-COLOR2"; + "FILL-PERCENT"; + "FILLER"; + "FINAL"; + "FINALLY"; + "FINISH-REASON"; + "FIRST"; + "FIXED"; + "FIXED-FONT"; + "FIXED-WIDTH"; + "FLAT"; + "FLAT-BUTTONS"; + "FLOAT"; + "FLOAT-BINARY-128"; + "FLOAT-BINARY-32"; + "FLOAT-BINARY-64"; + "FLOAT-DECIMAL-16"; + "FLOAT-DECIMAL-34"; + "FLOAT-EXTENDED"; + "FLOAT-INFINITY"; + "FLOAT-LONG"; + "FLOAT-NOT-A-NUMBER"; + "FLOAT-SHORT"; + "FLOATING"; + "FONT"; + "FOOTING"; + "FOR"; + "FOREGROUND-COLOR"; + "FOREVER"; + "FORMAT"; + "FRAME"; + "FRAMED"; + "FREE"; + "FROM"; + "FULL"; + "FULL-HEIGHT"; + "FUNCTION"; + "FUNCTION-ID"; + "FUNCTION-POINTER"; + "GENERATE"; + "GET"; + "GIVING"; + "GLOBAL"; + "GO"; + "GO-BACK"; + "GO-FORWARD"; + "GO-HOME"; + "GO-SEARCH"; + "GOBACK"; + "GRAPHICAL"; + "GREATER"; + "GRID"; + "GROUP"; + "GROUP-USAGE"; + "GROUP-VALUE"; + "HANDLE"; + "HAS-CHILDREN"; + "HEADING"; + "HEADING-COLOR"; + "HEADING-DIVIDER-COLOR"; + "HEADING-FONT"; + "HEAVY"; + "HEIGHT-IN-CELLS"; + "HEX"; + "HIDDEN-DATA"; + "HIGH-COLOR"; + "HIGH-VALUE"; + "HIGHLIGHT"; + "HOT-TRACK"; + "HSCROLL"; + "HSCROLL-POS"; + "I-O"; + "I-O-CONTROL"; + "ICON"; + "ID"; + "IDENTIFICATION"; + "IDENTIFIED"; + "IF"; + "IGNORE"; + "IGNORING"; + "IMPLEMENTS"; + "IN"; + "INDEPENDENT"; + "INDEX"; + "INDEXED"; + "INDICATE"; + "INHERITS"; + "INITIAL"; + "INITIALIZE"; + "INITIALIZED"; + "INITIATE"; + "INPUT"; + "INPUT-OUTPUT"; + "INQUIRE"; + "INSERTION-INDEX"; + "INSERT-ROWS"; + "INSPECT"; + "INSTALLATION"; + "INTERFACE"; + "INTERFACE-ID"; + "INTERMEDIATE"; + "INTO"; + "INTRINSIC"; + "INVALID"; + "INVOKE"; + "IS"; + "ITEM"; + "ITEM-TEXT"; + "ITEM-TO-ADD"; + "ITEM-TO-DELETE"; + "ITEM-TO-EMPTY"; + "ITEM-VALUE"; + "JSON"; + "JUST"; + "JUSTIFIED"; + "KEPT"; + "KEY"; + "KEYBOARD"; + "LABEL"; + "LABEL-OFFSET"; + "LARGE-FONT"; + "LARGE-OFFSET"; + "LAST"; + "LAST-ROW"; + "LAYOUT-DATA"; + "LAYOUT-MANAGER"; + "LC_ALL"; + "LC_COLLATE"; + "LC_CTYPE"; + "LC_MESSAGES"; + "LC_MONETARY"; + "LC_NUMERIC"; + "LC_TIME"; + "LEADING"; + "LEADING-SHIFT"; + "LEAVE"; + "LEFT"; + "LEFT-JUSTIFY"; + "LEFT-TEXT"; + "LEFTLINE"; + "LENGTH"; + "LESS"; + "LIKE"; + "LIMIT"; + "LIMITS"; + "LINAGE"; + "LINAGE-COUNTER"; + "LINE"; + "LINE-COUNTER"; + "LINE-SEQUENTIAL"; + "LINES"; + "LINES-AT-ROOT"; + "LINKAGE"; + "LIST-BOX"; + "LM-RESIZE"; + "LOC"; + "LOCAL-STORAGE"; + "LOCALE"; + "LOCATION"; + "LOCK"; + "LOCK-HOLDING"; + "LONG-DATE"; + "LOW-COLOR"; + "LOW-VALUE"; + "LOWER"; + "LOWERED"; + "LOWLIGHT"; + "MAGNETIC-TAPE"; + "MANUAL"; + "MASS-UPDATE"; + "MASTER-INDEX"; + "MAX-LINES"; + "MAX-PROGRESS"; + "MAX-TEXT"; + "MAX-VAL"; + "MEDIUM-FONT"; + "MEMORY"; + "MENU"; + "MERGE"; + "MESSAGE"; + "MESSAGE-TAG"; + "METHOD"; + "METHOD-ID"; + "MICROSECOND-TIME"; + "MIN-VAL"; + "MINUS"; + "MODE"; + "MODIFY"; + "MODULES"; + "MOVE"; + "MULTILINE"; + "MULTIPLE"; + "MULTIPLY"; + "NAME"; + "NAMED"; + "NAMESPACE"; + "NAMESPACE-PREFIX"; + "NAT"; + "NATIONAL"; + "NATIONAL-EDITED"; + "NATIVE"; + "NAVIGATE-URL"; + "NEAREST-AWAY-FROM-ZERO"; + "NEAREST-EVEN"; + "NEAREST-TOWARD-ZERO"; + "NEGATIVE"; + "NESTED"; + "NEW"; + "NEXT"; + "NEXT-ITEM"; + "NO"; + "NO-AUTOSEL"; + "NO-AUTO-DEFAULT"; + "NO-BOX"; + "NO-DIVIDERS"; + "NO-ECHO"; + "NO-F4"; + "NO-FOCUS"; + "NO-GROUP-TAB"; + "NO-KEY-LETTER"; + "NOMINAL"; + "NO-SEARCH"; + "NO-UPDOWN"; + "NONE"; + "NONNUMERIC"; + "NORMAL"; + "NOT"; + "NOTAB"; + "NOTHING"; + "NOTIFY"; + "NOTIFY-CHANGE"; + "NOTIFY-DBLCLICK"; + "NOTIFY-SELCHANGE"; + "NULL"; + "NULLS"; + "NUM-COL-HEADINGS"; + "NUM-ROWS"; + "NUMBER"; + "NUMBERS"; + "NUMERIC"; + "NUMERIC-EDITED"; + "OBJECT"; + "OBJECT-COMPUTER"; + "OBJECT-REFERENCE"; + "OCCURS"; + "OF"; + "OFF"; + "OK-BUTTON"; + "OMITTED"; + "ON"; + "ONLY"; + "OPEN"; + "OPTIONAL"; + "OPTIONS"; + "OR"; + "ORDER"; + "ORGANIZATION"; + "OTHER"; + "OTHERS"; + "OUTPUT"; + "OVERFLOW"; + "OVERLAP-LEFT"; + "OVERLAP-TOP"; + "OVERLINE"; + "OVERRIDE"; + "PACKED-DECIMAL"; + "PADDING"; + "PAGE"; + "PAGE-COUNTER"; + "PAGE-SETUP"; + "PAGED"; + "PARAGRAPH"; + "PARENT"; + "PARSE"; + "PASCAL"; + "PASSWORD"; + "PERFORM"; + "PERMANENT"; + "PF"; + "PH"; + "PHYSICAL"; + "PIC"; + "PICTURE"; + "PIXEL"; + "PLACEMENT"; + "PLUS"; + "POINTER"; + "POP-UP"; + "POS"; + "POSITION"; + "POSITION-SHIFT"; + "POSITIVE"; + "PREFIXED"; + "PRESENT"; + "PREVIOUS"; + "PRINT"; + "PRINT-NO-PROMPT"; + "PRINT-PREVIEW"; + "PRINTER"; + "PRINTER-1"; + "PRINTING"; + "PRIORITY"; + "PROCEDURE"; + "PROCEDURE-POINTER"; + "PROCEDURES"; + "PROCEED"; + "PROCESSING"; + "PROGRAM"; + "PROGRAM-ID"; + "PROGRAM-POINTER"; + "PROGRESS"; + "PROHIBITED"; + "PROMPT"; + "PROPERTIES"; + "PROPERTY"; + "PROTECTED"; + "PROTOTYPE"; + "PURGE"; + "PUSH-BUTTON"; + "QUERY-INDEX"; + "QUEUE"; + "QUOTE"; + "QUOTES"; + "RADIO-BUTTON"; + "RAISE"; + "RAISED"; + "RAISING"; + "RANDOM"; + "RD"; + "READ"; + "READ-ONLY"; + "READERS"; + "RECEIVE"; + "RECEIVED"; + "RECORD"; + "RECORD-DATA"; + "RECORD-OVERFLOW"; + "RECORD-TO-ADD"; + "RECORD-TO-DELETE"; + "RECORDING"; + "RECORDS"; + "RECURSIVE"; + "REDEFINES"; + "REEL"; + "REFERENCE"; + "REFERENCES"; + "REFRESH"; + "REGION-COLOR"; + "RELATION"; + "RELATIVE"; + "RELEASE"; + "REMAINDER"; + "REMARKS"; + "REMOVAL"; + "RENAMES"; + "REORG-CRITERIA"; + "REPEATED"; + "REPLACE"; + "REPLACING"; + "REPORT"; + "REPORTING"; + "REPORTS"; + "REPOSITORY"; + "REQUIRED"; + "REREAD"; + "RERUN"; + "RESERVE"; + "RESET"; + "RESET-GRID"; + "RESET-LIST"; + "RESET-TABS"; + "RESUME"; + "RETRY"; + "RETURN"; + "RETURNING"; + "REVERSE"; + "REVERSE-VIDEO"; + "REVERSED"; + "REWIND"; + "REWRITE"; + "RF"; + "RH"; + "RIGHT"; + "RIGHT-ALIGN"; + "RIGHT-JUSTIFY"; + "RIMMED"; + "ROLLBACK"; + "ROUNDED"; + "ROUNDING"; + "ROW-COLOR"; + "ROW-COLOR-PATTERN"; + "ROW-DIVIDERS"; + "ROW-FONT"; + "ROW-HEADINGS"; + "ROW-PROTECTION"; + "RUN"; + "S"; + "SAME"; + "SAVE-AS"; + "SAVE-AS-NO-PROMPT"; + "SCREEN"; + "SCROLL"; + "SCROLL-BAR"; + "SD"; + "SEARCH"; + "SEARCH-OPTIONS"; + "SEARCH-TEXT"; + "SECONDS"; + "SECTION"; + "SECURE"; + "SECURITY"; + "SEGMENT"; + "SEGMENT-LIMIT"; + "SELECT"; + "SELECT-ALL"; + "SELECTION-INDEX"; + "SELECTION-TEXT"; + "SELF"; + "SELF-ACT"; + "SEND"; + "SENTENCE"; + "SEPARATE"; + "SEPARATION"; + "SEQUENCE"; + "SEQUENTIAL"; + "SET"; + "SHADING"; + "SHADOW"; + "SHARING"; + "SHORT-DATE"; + "SHOW-LINES"; + "SHOW-NONE"; + "SHOW-SEL-ALWAYS"; + "SIGN"; + "SIGNED"; + "SIGNED-INT"; + "SIGNED-LONG"; + "SIGNED-SHORT"; + "SIZE"; + "SMALL-FONT"; + "SORT"; + "SORT-MERGE"; + "SORT-ORDER"; + "SOURCE"; + "SOURCE-COMPUTER"; + "SOURCES"; + "SPACE"; + "SPACE-FILL"; + "SPACES"; + "SPECIAL-NAMES"; + "SPINNER"; + "SQUARE"; + "STACK"; + "STANDARD"; + "STANDARD-1"; + "STANDARD-2"; + "STANDARD-BINARY"; + "STANDARD-DECIMAL"; + "START"; + "START-X"; + "START-Y"; + "STATEMENT"; + "STATIC"; + "STATIC-LIST"; + "STATUS"; + "STATUS-BAR"; + "STATUS-TEXT"; + "STDCALL"; + "STEP"; + "STOP"; + "STRING"; + "STRONG"; + "STYLE"; + "SUB-QUEUE-1"; + "SUB-QUEUE-2"; + "SUB-QUEUE-3"; + "SUBTRACT"; + "SUBWINDOW"; + "SUM"; + "SUPER"; + "SUPPRESS"; + "SYMBOL"; + "SYMBOLIC"; + "SYNC"; + "SYNCHRONIZED"; + "SYSTEM-DEFAULT"; + "SYSTEM-INFO"; + "SYSTEM-OFFSET"; + "TAB"; + "TAB-TO-ADD"; + "TAB-TO-DELETE"; + "TABLE"; + "TALLYING"; + "TAPE"; + "TEMPORARY"; + "TERMINAL"; + "TERMINAL-INFO"; + "TERMINATE"; + "TERMINATION-VALUE"; + "TEST"; + "TEXT"; + "THAN"; + "THEN"; + "THREAD"; + "THREADS"; + "THROUGH"; + "THRU"; + "THUMB-POSITION"; + "TILED-HEADINGS"; + "TIME"; + "TIME-OUT"; + "TIMES"; + "TITLE"; + "TITLE-POSITION"; + "TO"; + "TOP"; + "TOP-LEVEL"; + "TOWARD-GREATER"; + "TOWARD-LESSER"; + "TRACK"; + "TRACKS"; + "TRACK-AREA"; + "TRACK-LIMIT"; + "TRADITIONAL-FONT"; + "TRAILING"; + "TRAILING-SHIFT"; + "TRAILING-SIGN"; + "TRANSFORM"; + "TRANSPARENT"; + "TREE-VIEW"; + "TRUE"; + "TRUNCATION"; + "TYPE"; + "TYPEDEF"; + "U"; + "UCS-4"; + "UNBOUNDED"; + "UNDERLINE"; + "UNFRAMED"; + "UNIT"; + "UNIVERSAL"; + "UNLOCK"; + "UNSIGNED"; + "UNSIGNED-INT"; + "UNSIGNED-LONG"; + "UNSIGNED-SHORT"; + "UNSORTED"; + "UNSTRING"; + "UNTIL"; + "UP"; + "UPDATE"; + "UPDATERS"; + "UPON"; + "UPPER"; + "USAGE"; + "USE"; + "USE-ALT"; + "USE-RETURN"; + "USE-TAB"; + "USER"; + "USER-DEFAULT"; + "USING"; + "UTF-16"; + "UTF-8"; + "V"; + "VAL-STATUS"; + "VALID"; + "VALIDATE"; + "VALIDATE-STATUS"; + "VALIDATING"; + "VALUE"; + "VALUES"; + "VALUE-FORMAT"; + "VARIABLE"; + "VARIANT"; + "VARYING"; + "VERTICAL"; + "VERY-HEAVY"; + "VIRTUAL-WIDTH"; + "VOLATILE"; + "VPADDING"; + "VSCROLL"; + "VSCROLL-BAR"; + "VSCROLL-POS"; + "VTOP"; + "WAIT"; + "WEB-BROWSER"; + "WHEN"; + "WIDTH"; + "WIDTH-IN-CELLS"; + "WINDOW"; + "WITH"; + "WORDS"; + "WORKING-STORAGE"; + "WRAP"; + "WRITE"; + "WRITE-ONLY"; + "WRITE-VERIFY"; + "WRITERS"; + "X"; + "XML"; + "XML-DECLARATION"; + "XML-SCHEMA"; + "XOR"; + "Y"; + "YYYYDDD"; + "YYYYMMDD"; + "ZERO"; + "ZERO-FILL"; ] + +let words = + let reserve w = w, Types.ReserveWord { preserve_context_sensitivity = true } in + List.rev @@ List.rev_map reserve reserved_words + +(** The set of all available intrinsic functions *) +let intrinsic_functions = + StringSet.of_list @@ + [ "ABS"; + "ABSOLUTE-VALUE"; + "ACOS"; + "ANNUITY"; + "ASIN"; + "ATAN"; + "BASECONVERT"; + "BIT-OF"; + "BIT-TO-CHAR"; + "BOOLEAN-OF-INTEGER"; + "BYTE-LENGTH"; + "CHAR"; + "CHAR-NATIONAL"; + "COMBINED-DATETIME"; + "CONCAT"; + "CONCATENATE"; + "CONTENT-LENGTH"; + "CONTENT-OF"; + "CONVERT"; + "COS"; + "CURRENCY-SYMBOL"; + "CURRENT-DATE"; + "DATE-OF-INTEGER"; + "DATE-TO-YYYYMMDD"; + "DAY-OF-INTEGER"; + "DAY-TO-YYYYDDD"; + "DISPLAY-OF"; + "E"; + "EXCEPTION-FILE"; + "EXCEPTION-FILE-N"; + "EXCEPTION-LOCATION"; + "EXCEPTION-LOCATION-N"; + "EXCEPTION-STATEMENT"; + "EXCEPTION-STATUS"; + "EXP"; + "EXP10"; + "FACTORIAL"; + "FIND-STRING"; + "FORMATTED-CURRENT-DATE"; + "FORMATTED-DATE"; + "FORMATTED-DATETIME"; + "FORMATTED-TIME"; + "FRACTION-PART"; + "HEX-OF"; + "HEX-TO-CHAR"; + "HIGHEST-ALGEBRAIC"; + "INTEGER"; + "INTEGER-OF-BOOLEAN"; + "INTEGER-OF-DATE"; + "INTEGER-OF-DAY"; + "INTEGER-OF-FORMATTED-DATE"; + "INTEGER-PART"; + "LENGTH"; + "LENGTH-AN"; + "LOCALE-COMPARE"; + "LOCALE-DATE"; + "LOCALE-TIME"; + "LOCALE-TIME-FROM-SECONDS"; + "LOG"; + "LOG10"; + "LOWER-CASE"; + "LOWEST-ALGEBRAIC"; + "MAX"; + "MEAN"; + "MEDIAN"; + "MIDRANGE"; + "MIN"; + "MOD"; + "MODULE-CALLER-ID"; + "MODULE-DATE"; + "MODULE-FORMATTED-DATE"; + "MODULE-ID"; + "MODULE-NAME"; + "MODULE-PATH"; + "MODULE-SOURCE"; + "MODULE-TIME"; + "MONETARY-DECIMAL-POINT"; + "MONETARY-THOUSANDS-SEPARATOR"; + "NATIONAL-OF"; + "NUMERIC-DECIMAL-POINT"; + "NUMERIC-THOUSANDS-SEPARATOR"; + "NUMVAL"; + "NUMVAL-C"; + "NUMVAL-F"; + "ORD"; + "ORD-MAX"; + "ORD-MIN"; + "PI"; + "PRESENT-VALUE"; + "RANDOM"; + "RANGE"; + "REM"; + "REVERSE"; + "SECONDS-FROM-FORMATTED-TIME"; + "SECONDS-PAST-MIDNIGHT"; + "SIGN"; + "SIN"; + "SQRT"; + "STANDARD-COMPARE"; + "STANDARD-DEVIATION"; + "STORED-CHAR-LENGTH"; + "SUBSTITUTE"; + "SUBSTITUTE-CASE"; + "SUM"; + "TAN"; + "TEST-DATE-YYYYMMDD"; + "TEST-DAY-YYYYDDD"; + "TEST-FORMATTED-DATETIME"; + "TEST-NUMVAL"; + "TEST-NUMVAL-C"; + "TEST-NUMVAL-F"; + "TRIM"; + "UPPER-CASE"; + "VARIANCE"; + "WHEN-COMPILED"; + "YEAR-TO-YYYY"; ] + +(** Disabled or unimplemented intrinsic functions *) +let disabled_intrinsic = + StringSet.of_list @@ + [ (*disabled*) + "ABSOLUTE-VALUE"; + (*not implemented*) + "BASECONVERT"; + "BOOLEAN-OF-INTEGER"; + "CHAR-NATIONAL"; + "CONVERT"; + "DISPLAY-OF"; + "EXCEPTION-FILE-N"; + "EXCEPTION-LOCATION-N"; + "FIND-STRING"; + "INTEGER-OF-BOOLEAN"; + "MODULE-NAME"; + "NATIONAL-OF"; + "STANDARD-COMPARE"; ] + +(** Defautls intrinsic functions *) +let default_intrinsics = + StringSet.diff intrinsic_functions disabled_intrinsic + +(** Set of available system names *) +let system_names = + StringSet.of_list @@ + [ "SYSIN"; + "SYSIPT"; + "STDIN"; + "SYSOUT"; + "SYSLIST"; + "SYSLST"; + "SYSPCH"; + "SYSPUNCH"; + "STDOUT"; + "PRINT"; + "PRINTER"; + "PRINTER-1"; + "SYSERR"; + "STDERR"; + "CONSOLE"; + "ALTERNATE-CONSOLE"; + "ALTERNATE CONSOLE"; + "TERMINAL"; + "C01"; + "C02"; + "C03"; + "C04"; + "C05"; + "C06"; + "C07"; + "C08"; + "C09"; + "C10"; + "C11"; + "C12"; + "S01"; + "S02"; + "S03"; + "S04"; + "S05"; + "CSP"; + "FORMFEED"; + "TOP"; + "CALL-CONVENTION"; + "SWITCH-0"; + "SWITCH-1"; + "SWITCH-2"; + "SWITCH-3"; + "SWITCH-4"; + "SWITCH-5"; + "SWITCH-6"; + "SWITCH-7"; + "SWITCH-8"; + "SWITCH-9"; + "SWITCH-10"; + "SWITCH-11"; + "SWITCH-12"; + "SWITCH-13"; + "SWITCH-14"; + "SWITCH-15"; + "SWITCH-16"; + "SWITCH-17"; + "SWITCH-18"; + "SWITCH-19"; + "SWITCH-20"; + "SWITCH-21"; + "SWITCH-22"; + "SWITCH-23"; + "SWITCH-24"; + "SWITCH-25"; + "SWITCH-26"; + "SWITCH-27"; + "SWITCH-28"; + "SWITCH-29"; + "SWITCH-30"; + "SWITCH-31"; + "SWITCH-32"; + "SWITCH-33"; + "SWITCH-34"; + "SWITCH-35"; + "SWITCH-36"; + "SW0"; + "SW1"; + "SW2"; + "SW3"; + "SW4"; + "SW5"; + "SW6"; + "SW7"; + "SW8"; + "SW9"; + "SW10"; + "SW11"; + "SW12"; + "SW13"; + "SW14"; + "SW15"; + "SWITCH 0"; + "SWITCH 1"; + "SWITCH 2"; + "SWITCH 3"; + "SWITCH 4"; + "SWITCH 5"; + "SWITCH 6"; + "SWITCH 7"; + "SWITCH 8"; + "SWITCH 9"; + "SWITCH 10"; + "SWITCH 11"; + "SWITCH 12"; + "SWITCH 13"; + "SWITCH 14"; + "SWITCH 15"; + "SWITCH 16"; + "SWITCH 17"; + "SWITCH 18"; + "SWITCH 19"; + "SWITCH 20"; + "SWITCH 21"; + "SWITCH 22"; + "SWITCH 23"; + "SWITCH 24"; + "SWITCH 25"; + "SWITCH 26"; + "SWITCH A"; + "SWITCH B"; + "SWITCH C"; + "SWITCH D"; + "SWITCH E"; + "SWITCH F"; + "SWITCH G"; + "SWITCH H"; + "SWITCH I"; + "SWITCH J"; + "SWITCH K"; + "SWITCH L"; + "SWITCH M"; + "SWITCH N"; + "SWITCH O"; + "SWITCH P"; + "SWITCH Q"; + "SWITCH R"; + "SWITCH S"; + "SWITCH T"; + "SWITCH U"; + "SWITCH V"; + "SWITCH W"; + "SWITCH X"; + "SWITCH Y"; + "SWITCH Z"; + "UPSI-0"; + "UPSI-1"; + "UPSI-2"; + "UPSI-3"; + "UPSI-4"; + "UPSI-5"; + "UPSI-6"; + "UPSI-7"; + "UPSI-8"; + "USW-0"; + "USW-1"; + "USW-2"; + "USW-3"; + "USW-4"; + "USW-5"; + "USW-6"; + "USW-7"; + "USW-8"; + "USW-9"; + "USW-10"; + "USW-11"; + "USW-12"; + "USW-13"; + "USW-14"; + "USW-15"; + "USW-16"; + "USW-17"; + "USW-18"; + "USW-19"; + "USW-20"; + "USW-21"; + "USW-22"; + "USW-23"; + "USW-24"; + "USW-25"; + "USW-26"; + "USW-27"; + "USW-28"; + "USW-29"; + "USW-30"; + "USW-31"; ] + +(** Disabled system names by default *) +let disabled_system_names = + StringSet.of_list @@ + [ "SW0"; + "SW1"; + "SW2"; + "SW3"; + "SW4"; + "SW5"; + "SW6"; + "SW7"; + "SW8"; + "SW9"; + "SW10"; + "SW11"; + "SW12"; + "SW13"; + "SW14"; + "SW15"; + "SWITCH 0"; + "SWITCH 1"; + "SWITCH 2"; + "SWITCH 3"; + "SWITCH 4"; + "SWITCH 5"; + "SWITCH 6"; + "SWITCH 7"; + "SWITCH 8"; + "SWITCH 9"; + "SWITCH 10"; + "SWITCH 11"; + "SWITCH 12"; + "SWITCH 13"; + "SWITCH 14"; + "SWITCH 15"; + "SWITCH 16"; + "SWITCH 17"; + "SWITCH 18"; + "SWITCH 19"; + "SWITCH 20"; + "SWITCH 21"; + "SWITCH 22"; + "SWITCH 23"; + "SWITCH 24"; + "SWITCH 25"; + "SWITCH 26"; + "SWITCH A"; + "SWITCH B"; + "SWITCH C"; + "SWITCH D"; + "SWITCH E"; + "SWITCH F"; + "SWITCH G"; + "SWITCH H"; + "SWITCH I"; + "SWITCH J"; + "SWITCH K"; + "SWITCH L"; + "SWITCH M"; + "SWITCH N"; + "SWITCH O"; + "SWITCH P"; + "SWITCH Q"; + "SWITCH R"; + "SWITCH S"; + "SWITCH T"; + "SWITCH U"; + "SWITCH V"; + "SWITCH W"; + "SWITCH X"; + "SWITCH Y"; + "SWITCH Z"; + "UPSI-0"; + "UPSI-1"; + "UPSI-2"; + "UPSI-3"; + "UPSI-4"; + "UPSI-5"; + "UPSI-6"; + "UPSI-7"; + "UPSI-8"; + "USW-0"; + "USW-1"; + "USW-2"; + "USW-3"; + "USW-4"; + "USW-5"; + "USW-6"; + "USW-7"; + "USW-8"; + "USW-9"; + "USW-10"; + "USW-11"; + "USW-12"; + "USW-13"; + "USW-14"; + "USW-15"; + "USW-16"; + "USW-17"; + "USW-18"; + "USW-19"; + "USW-20"; + "USW-21"; + "USW-22"; + "USW-23"; + "USW-24"; + "USW-25"; + "USW-26"; + "USW-27"; + "USW-28"; + "USW-29"; + "USW-30"; + "USW-31"; ] + +(** Default system names *) +let default_system_names = + StringSet.diff system_names disabled_system_names + +(** DIALECT-ALL-DEVICES system names *) +let device_system_names = + StringSet.of_list @@ + [ "SYSIN"; + "SYSIPT"; + "STDIN"; + "SYSOUT"; + "SYSLIST"; + "SYSLST"; + "SYSPCH"; + "SYSPUNCH"; + "STDOUT"; + "PRINT"; + "PRINTER"; + "PRINTER-1"; + "SYSERR"; + "STDERR"; + "CONSOLE"; + "ALTERNATE-CONSOLE"; + "ALTERNATE CONSOLE"; + "TERMINAL"; ] + +(** DIALECT-ALL-FEATURES system names *) +let feature_system_names = + StringSet.of_list @@ + [ "C01"; + "C02"; + "C03"; + "C04"; + "C05"; + "C06"; + "C07"; + "C08"; + "C09"; + "C10"; + "C11"; + "C12"; + "S01"; + "S02"; + "S03"; + "S04"; + "S05"; + "CSP"; + "FORMFEED"; + "TOP"; + "CALL-CONVENTION"; ] + +(** DIALECT-ALL-SWITCHES system names *) +let switch_system_names = + StringSet.of_list @@ + [ "SWITCH-0"; + "SWITCH-1"; + "SWITCH-2"; + "SWITCH-3"; + "SWITCH-4"; + "SWITCH-5"; + "SWITCH-6"; + "SWITCH-7"; + "SWITCH-8"; + "SWITCH-9"; + "SWITCH-10"; + "SWITCH-11"; + "SWITCH-12"; + "SWITCH-13"; + "SWITCH-14"; + "SWITCH-15"; + "SWITCH-16"; + "SWITCH-17"; + "SWITCH-18"; + "SWITCH-19"; + "SWITCH-20"; + "SWITCH-21"; + "SWITCH-22"; + "SWITCH-23"; + "SWITCH-24"; + "SWITCH-25"; + "SWITCH-26"; + "SWITCH-27"; + "SWITCH-28"; + "SWITCH-29"; + "SWITCH-30"; + "SWITCH-31"; + "SWITCH-32"; + "SWITCH-33"; + "SWITCH-34"; + "SWITCH-35"; + "SWITCH-36"; + "SW0"; + "SW1"; + "SW2"; + "SW3"; + "SW4"; + "SW5"; + "SW6"; + "SW7"; + "SW8"; + "SW9"; + "SW10"; + "SW11"; + "SW12"; + "SW13"; + "SW14"; + "SW15"; + "SWITCH 0"; + "SWITCH 1"; + "SWITCH 2"; + "SWITCH 3"; + "SWITCH 4"; + "SWITCH 5"; + "SWITCH 6"; + "SWITCH 7"; + "SWITCH 8"; + "SWITCH 9"; + "SWITCH 10"; + "SWITCH 11"; + "SWITCH 12"; + "SWITCH 13"; + "SWITCH 14"; + "SWITCH 15"; + "SWITCH 16"; + "SWITCH 17"; + "SWITCH 18"; + "SWITCH 19"; + "SWITCH 20"; + "SWITCH 21"; + "SWITCH 22"; + "SWITCH 23"; + "SWITCH 24"; + "SWITCH 25"; + "SWITCH 26"; + "SWITCH A"; + "SWITCH B"; + "SWITCH C"; + "SWITCH D"; + "SWITCH E"; + "SWITCH F"; + "SWITCH G"; + "SWITCH H"; + "SWITCH I"; + "SWITCH J"; + "SWITCH K"; + "SWITCH L"; + "SWITCH M"; + "SWITCH N"; + "SWITCH O"; + "SWITCH P"; + "SWITCH Q"; + "SWITCH R"; + "SWITCH S"; + "SWITCH T"; + "SWITCH U"; + "SWITCH V"; + "SWITCH W"; + "SWITCH X"; + "SWITCH Y"; + "SWITCH Z"; + "UPSI-0"; + "UPSI-1"; + "UPSI-2"; + "UPSI-3"; + "UPSI-4"; + "UPSI-5"; + "UPSI-6"; + "UPSI-7"; + "UPSI-8"; + "USW-0"; + "USW-1"; + "USW-2"; + "USW-3"; + "USW-4"; + "USW-5"; + "USW-6"; + "USW-7"; + "USW-8"; + "USW-9"; + "USW-10"; + "USW-11"; + "USW-12"; + "USW-13"; + "USW-14"; + "USW-15"; + "USW-16"; + "USW-17"; + "USW-18"; + "USW-19"; + "USW-20"; + "USW-21"; + "USW-22"; + "USW-23"; + "USW-24"; + "USW-25"; + "USW-26"; + "USW-27"; + "USW-28"; + "USW-29"; + "USW-30"; + "USW-31"; ] + +(** Set of available registers *) +let registers = + StringSet.of_list @@ + [ "ADDRESS OF"; + "COB-CRT-STATUS"; + "DEBUG-ITEM"; + "LENGTH OF"; + "NUMBER-OF-CALL-PARAMETERS"; + "RETURN-CODE"; + "SORT-RETURN"; + "TALLY"; + "COL"; + "LIN"; + "WHEN-COMPILED"; + "XML-CODE"; + "XML-EVENT"; + "XML-INFORMATION"; + "XML-NAMESPACE"; + "XML-NAMESPACE-PREFIX"; + "XML-NNAMESPACE"; + "XML-NNAMESPACE-PREFIX"; + "XML-NTEXT"; + "XML-TEXT"; + "JSON-CODE"; + "JSON-STATUS"; ] + +(** Disabled by default registers *) +let must_be_enabled_registers = + StringSet.of_list @@ + [ "COL"; + "LIN"; ] + +(** Default registers *) +let default_registers = + StringSet.diff registers must_be_enabled_registers diff --git a/src/lsp/cobol_config/reserved_words.mli b/src/lsp/cobol_config/reserved_words.mli new file mode 100644 index 000000000..a9b6c96de --- /dev/null +++ b/src/lsp/cobol_config/reserved_words.mli @@ -0,0 +1,25 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open EzCompat + +val words : (string * Types.word_spec) list +val default_intrinsics : StringSet.t +val default_registers : StringSet.t +val intrinsic_functions : StringSet.t +val default_system_names : StringSet.t +val switch_system_names : StringSet.t +val device_system_names : StringSet.t +val feature_system_names : StringSet.t +val system_names : StringSet.t +val registers : StringSet.t diff --git a/src/lsp/cobol_config/types.ml b/src/lsp/cobol_config/types.ml new file mode 100644 index 000000000..92af6a648 --- /dev/null +++ b/src/lsp/cobol_config/types.ml @@ -0,0 +1,502 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Module containing most of the types definitions used in {!Cobol_config}. *) + +open Cobol_common.Diagnostics.TYPES + +module DIAGS = Cobol_common.Diagnostics + +type doc = Pretty.simple + +(** Global configuration representative (default, gcos, gcos-strict, etc). Just + a name for now, but we could add some more info later (like configuration + files read). *) +type configuration = + (* May become an object a well, if revelant *) + { + name: string; (* e.g, "default", "MicroFocus", "ACU", "GCOS" *) + } + +(** Any object with a pretty-printing method. *) +class type showable = + object + method pp: Pretty.delayed + end + +(** Kind (type) of configuration options. *) +class virtual ['a] kind ~name = + object + val name: string = name + method name = name + method pp: Pretty.delayed = fun ppf -> Pretty.string ppf name + method virtual parse: string -> 'a + end + +let all_configs: showable list ref = ref [] (* for listing of options *) +let configurable_name_style = [`Yellow; `Bold] +and configurable_kind_style = [`Cyan] + +(** Any object that is configurable. *) +class virtual ['a] configurable ~name ~kind ?short doc = + let uncapitalize_heuristics s = match s.[1] with + | 'A' .. 'Z' | '-' -> s + | _ -> String.uncapitalize_ascii s + | exception Invalid_argument _ -> String.uncapitalize_ascii s + in + object (self) + val name: string = name + val kind: 'a kind = kind + val doc: doc = doc + method name = name + method short: doc = match short with + | Some s -> s + | None -> Pretty.Simple.map uncapitalize_heuristics doc + method pp ppf = + let pp_name = Pretty.styles configurable_name_style @@ Pretty.string + and pp_kind = Pretty.styles configurable_kind_style @@ Fmt.fmt "%t" in + Pretty.print ppf "@[<4>%a@ [%a]:@\n%(%)@]" + pp_name name pp_kind kind#pp doc + initializer begin + all_configs := (self :> showable) :: !all_configs; + end + end + +module FEATURE = struct + (** Optional features of COBOL dialects with support levels similar to those + in GnuCOBOL. *) + + (** Values for support levels. Those that do not raise errors may come with + option-specific values, hence the type parameter. *) + type 'a support_level = + | Ok of 'a + | Warning of 'a + | Archaic of 'a + | Obsolete of 'a + | Skip + | Ignore + | Error + | Unconformable + + (** Kind (type) of support level options *) + class virtual ['a] feature_kind ~name = + object(self) + inherit ['a support_level] kind ~name + method virtual from_ast: Conf_ast.support_value -> 'a support_level + method kind: 'a support_level kind = (self :> 'a support_level kind) + end + + + (** Generic kind of support, that carry no value; i.e, those are simple + flags. *) + let unit_kind = + object + inherit [unit] feature_kind ~name:"support" + method parse s = match String.lowercase_ascii s with + | "ok" -> Ok () + | "warning" -> Warning () + | "archaic" -> Archaic () + | "obsolete" -> Obsolete () + | "skip" -> Skip + | "ignore" -> Ignore + | "error" -> Error + | "unconformable" -> Unconformable + | _ as s -> raise @@ Invalid_argument s (* TODO: or error... *) + method from_ast: Conf_ast.support_value -> unit support_level = function + | Ok -> Ok () + | Warning -> Warning () + | Archaic -> Archaic () + | Obsolete -> Obsolete () + | Skip -> Skip + | Ignore -> Ignore + | Error -> Error + | Unconformable -> Unconformable + end + + (** Internal representation of a binding from a feature and a support + level. *) + class ['a] support feature ~config level = + object (self) + val feature: 'a support_level configurable = feature + val level: 'a support_level = level + method verify ~loc : _ result = + let open Cobol_common.Diagnostics.One in + let short = feature#short and config = config.name in + match level with + | Ok s -> + Ok (s, None) + | Warning s -> + Ok (s, Some (warn ?loc "%(%)@ used" short)) + | Archaic s -> + Ok (s, Some (warn ?loc "%(%)@ is@ archaic@ in@ %s" short config)) + | Obsolete s -> + Ok (s, Some (warn ?loc "%(%)@ is@ obsolete@ in@ %s" short config)) + | Skip -> + Error None + | Ignore -> + Error (Some (warn ?loc "%(%)@ ignored" short)) + | Error -> + Error (Some (error ?loc "%(%)@ used" short)) + | Unconformable -> + Error (Some (error ?loc "%(%)@ does@ not@ conform@ to@ \ + %s" short config)) + method verify' ~loc : _ option with_diags = (* transitional *) + match self#verify ~loc with + | Ok (s, diag) -> DIAGS.some_result s ~diags:(DIAGS.Set.maybe diag) + | Error diag -> DIAGS.no_result ~diags:(DIAGS.Set.maybe diag) + method level = level + end + + (** Type of optional COBOL dialect features. *) + class ['a] feature ~(feature_kind: 'a feature_kind) ~name ?short doc = + object (self) + inherit ['a support_level] + configurable ~kind:feature_kind#kind ~name ?short doc + method from_level: config:configuration -> 'a support_level -> 'a support = + new support (self :> 'a support_level configurable) + method from_string: config:configuration -> string -> 'a support = + fun ~config s -> self#from_level ~config (feature_kind#kind#parse s) + method from_ast: config:configuration -> Conf_ast.support_value -> 'a support = + fun ~config s -> self#from_level ~config (feature_kind#from_ast s) + end + + type 'a t = 'a feature + + (** Definitions *) + let def = new feature + let unit = new feature ~feature_kind:unit_kind + +end +type 'a feature = 'a FEATURE.t (* alias *) +type 'a feature_support = 'a FEATURE.support + +(* TODO: add min/max for int values. *) +module Value = struct + (** Valued (typed) options. *) + + (** Internal representation of typed option binding. *) + class ['a] v option ~config:_ v = + object + val option: 'a configurable = option + method value: 'a = v + end + + (** Type of valued options *) + class ['a] value ~kind ~name ?short doc = + object (self) + inherit ['a] configurable ~kind ~name ?short doc + method from_val: config:configuration -> 'a -> 'a v = + new v (self :> 'a configurable) + method from_string ~(config:configuration) str: 'a v = + let value = kind#parse str in + new v (self :> 'a configurable) ~config value + end + + type 'a t = 'a value + + (** Definitions *) + let def ~name = new value ~name + + let kind_from_fmt ~name fmt = + object + inherit [_] kind ~name + method parse s = Scanf.sscanf s fmt Fun.id + end + + let int = def ~kind:(kind_from_fmt ~name:"int" "%d") + let bool = def ~kind:(kind_from_fmt ~name:"bool" "%B") + +end +type 'a valued_option = 'a Value.v (* alias *) +type 'a value = 'a Value.t (* alias *) + +type defaultbyte = + | Char of char (* int values will be translated to char *) + | Init + | None + +type standard = + | GnuCOBOL + | MicroFocus + | IBM + | MVS + | BS2000 + | ACU + | RM + | STD85 + | STD2002 + | STD2014 + +type source_format = + | SFFree + | SFFixed + | SFVariable + | SFXOpen + | SFxCard + | SFCRT + | SFTrm + | SFCOBOLX + +type source_format_spec = + | Auto + | SF of source_format + +type binary_size = + | B_2_4_8 + | B_1_2_4_8 + | B_1__8 + +type binary_byteorder = + | Native + | Big_endian + +(* TODO: Check if IBM and MF change the behavior compared with Dynamic and External *) +type assign_clause = + | Dynamic + | External + | IBM + | MF + +type screen_section_rules = + | ACU + | GC + | MF + | RM + | STD + | XOPEN + +type dpc_in_data = + | None + | XML + | Json + | All + +type words_spec = (string * word_spec) list +and word_spec = + | ReserveWord of + { + preserve_context_sensitivity: bool; + } + | ReserveAlias of + { + alias_for: string; + preserve_context_sensitivity: bool; + } + | NotReserved + +module DIALECT = struct + + let all_canonical_names = + [ "default"; + "gnucobol"; "microfocus"; "mf"; "acu"; "gcos"; "ibm"; "cobol85"; + "GnuCOBOL"; "MicroFocus"; "MF"; "ACU"; "GCOS"; "IBM"; "COBOL85" ] + + type t = + | Default + | COBOL85 + | GnuCOBOL + | MicroFocus + | ACU + | GCOS + | IBM + + let name: t -> string = function + | Default -> "default" + | COBOL85 -> "COBOL85" + | GnuCOBOL -> "GnuCOBOL" + | MicroFocus -> "MicroFocus" + | ACU -> "ACU" + | GCOS -> "GCOS" + | IBM -> "IBM" + + let of_string: string -> t = fun s -> + match String.lowercase_ascii s with + | "default" -> Default + | "cobol85" -> COBOL85 + | "gnucobol" -> GnuCOBOL + | "microfocus" | "mf" -> MicroFocus + | "acu" -> ACU + | "gcos" -> GCOS + | "ibm" -> IBM + | _ -> invalid_arg s + + let of_name: string -> t = function + | "COBOL 85" -> COBOL85 + | "GnuCOBOL" -> GnuCOBOL (*TODO: or maybe default *) + | "Micro Focus COBOL" | "Micro Focus COBOL (lax)" -> MicroFocus + | "IBM COBOL" | "IBM COBOL (lax)" -> IBM + | "GCOS" | "GCOS (lax)" -> GCOS + | "ACUCOBOL-GT" | "ACUCOBOL-GT (lax)" -> ACU + | s -> of_string s + +end +type dialect = DIALECT.t + +module type CONFIG = sig + val dialect: dialect + val config: configuration +end + +module type PP_OPTS = sig + (** Preprocessor options*) + + (* int options *) + val tab_width: int valued_option + + (* support options *) + val comment_paragraphs: unit feature_support + val safe_partial_replacing_when_src_literal: [`Safe | `Unsafe] feature_support +end + +module type COMP_OPTS = sig + (** Compiler options *) + + (* reserved words *) + val words: words_spec + val intrinsic_functions: Cobol_common.Basics.StringSet.t + val system_names: Cobol_common.Basics.StringSet.t + val registers: Cobol_common.Basics.StringSet.t + + (* int options *) + val text_column: int valued_option + val pic_length: int valued_option + val word_length: int valued_option + val literal_length: int valued_option + val numeric_literal_length: int valued_option + + (* any options *) + val defaultbyte: defaultbyte valued_option + val standard_define: standard valued_option + val format: source_format_spec valued_option + val binary_size: binary_size valued_option + val binary_byteorder: binary_byteorder valued_option + val assign_clause: assign_clause valued_option + val screen_section_rules: screen_section_rules valued_option + val dpc_in_data: dpc_in_data valued_option + + (* boolean options *) + val filename_mapping: bool valued_option + val pretty_display: bool valued_option + val binary_truncate: bool valued_option + val complex_odo: bool valued_option + val odoslide: bool valued_option + val indirect_redefines: bool valued_option + val relax_syntax_checks: bool valued_option + val ref_mod_zero_length: bool valued_option + val relax_level_hierarchy: bool valued_option + val select_working: bool valued_option + val local_implies_recursive: bool valued_option + val sticky_linkage: bool valued_option + val move_ibm: bool valued_option + val perform_osvs: bool valued_option + val arithmetic_osvs: bool valued_option + val hostsign: bool valued_option + val program_name_redefinition: bool valued_option + val accept_update: bool valued_option + val accept_auto: bool valued_option + val console_is_crt: bool valued_option + val no_echo_means_secure: bool valued_option + val line_col_zero_default: bool valued_option + val display_special_fig_consts: bool valued_option + val binary_comp_1: bool valued_option + val numeric_pointer: bool valued_option + val move_non_numeric_lit_to_numeric_is_zero: bool valued_option + val implicit_assign_dynamic_var: bool valued_option + val device_mnemonics: bool valued_option + val xml_parse_xmlss: bool valued_option + val areacheck: bool valued_option + val ebcdic_symbolic_characters: bool valued_option + + (* support options *) + val control_division: unit feature_support + val memory_size_clause: unit feature_support + val multiple_file_tape_clause: unit feature_support + val label_records_clause: unit feature_support + val value_of_clause: unit feature_support + val data_records_clause: unit feature_support + val top_level_occurs_clause: unit feature_support + val same_as_clause: unit feature_support + val type_to_clause: unit feature_support + val usage_type: unit feature_support + val synchronized_clause: unit feature_support + val sync_left_right: unit feature_support + val special_names_clause: unit feature_support + val goto_statement_without_name: unit feature_support + val stop_literal_statement: unit feature_support + val stop_identifier_statement: unit feature_support + val stop_error_statement: unit feature_support + val debugging_mode: unit feature_support + val use_for_debugging: unit feature_support + val padding_character_clause: unit feature_support + val next_sentence_phrase: unit feature_support + val listing_statements: unit feature_support + val title_statement: unit feature_support + val entry_statement: unit feature_support + val move_noninteger_to_alphanumeric: unit feature_support + val move_figurative_constant_to_numeric: unit feature_support + val move_figurative_space_to_numeric: unit feature_support + val move_figurative_quote_to_numeric: unit feature_support + val odo_without_to: unit feature_support + val section_segments: unit feature_support + val alter_statement: unit feature_support + val call_overflow: unit feature_support + val numeric_boolean: unit feature_support + val hexadecimal_boolean: unit feature_support + val national_literals: unit feature_support + val hexadecimal_national_literals: unit feature_support + val national_character_literals: unit feature_support + val hp_octal_literals: unit feature_support + val acu_literals: unit feature_support + val word_continuation: unit feature_support + val not_exception_before_exception: unit feature_support + val accept_display_extensions: unit feature_support + val larger_redefines: unit feature_support + val symbolic_constant: unit feature_support + val constant_78: unit feature_support + val constant_01: unit feature_support + val perform_varying_without_by: unit feature_support + val reference_out_of_declaratives: unit feature_support + val program_prototypes: unit feature_support + val call_convention_mnemonic: unit feature_support + val call_convention_linkage: unit feature_support + val numeric_value_for_edited_item: unit feature_support + val incorrect_conf_sec_order: unit feature_support + val define_constant_directive: unit feature_support + val free_redefines_position: unit feature_support + val records_mismatch_record_clause: unit feature_support + val record_delimiter: unit feature_support + val sequential_delimiters: unit feature_support + val record_delim_with_fixed_recs: unit feature_support + val missing_statement: unit feature_support + val missing_period: unit feature_support + val zero_length_literals: unit feature_support + val xml_generate_extra_phrases: unit feature_support + val continue_after: unit feature_support + val goto_entry: unit feature_support + val assign_variable: unit feature_support + val assign_using_variable: unit feature_support + val assign_ext_dyn: unit feature_support + val assign_disk_from: unit feature_support + val vsam_status: unit feature_support + val self_call_recursive: unit feature_support + val record_contains_depending_clause: unit feature_support + val picture_l: unit feature_support +end + +module type T = sig + include CONFIG + include PP_OPTS + include COMP_OPTS +end + +type t = (module T) diff --git a/src/polka-js-stubs/version.mlt b/src/lsp/cobol_config/version.mlt similarity index 100% rename from src/polka-js-stubs/version.mlt rename to src/lsp/cobol_config/version.mlt diff --git a/src/lsp/cobol_config/words.ml b/src/lsp/cobol_config/words.ml new file mode 100644 index 000000000..62cced9ab --- /dev/null +++ b/src/lsp/cobol_config/words.ml @@ -0,0 +1,154 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Basics + +module FATAL = Cobol_common.Diagnostics.Fatal + +type kind = + | DialectAll + | DialectAllDevices + | DialectAllSwitches + | DialectAllFeatures + | Word of string + +let kind_of_string = function + | "DIALECT-ALL" -> DialectAll + | "DIALECT-ALL-DEVICES" -> DialectAllDevices + | "DIALECT-ALL-SWITCHES" -> DialectAllSwitches + | "DIALECT-ALL-FEATURES" -> DialectAllFeatures + | s -> Word s + +(** Module containing all the modules used to build all the reserved words sets *) + +(*NOTE: no `mli` as this module is not to be used outside of `Cobol_config` *) + +(** This module is used to build reserved words set and aliases map. *) +module RESERVED = struct + + let conf : Types.words_spec ref = ref [] + let cons s = conf := s :: !conf + + let categorize word = + if Str.last_chars word 1 = "*" + then String.sub word 0 (String.length word - 1), true + else word, false + + let add_reserved str = + match kind_of_string str with + | DialectAll -> + conf := List.rev_append Reserved_words.words !conf + | Word str -> + let w, preserve_context_sensitivity = categorize str in + cons (w, Types.ReserveWord { preserve_context_sensitivity }) + | _ -> Pretty.failwith "Wrong DIALECT-* word" str + + let add_alias alias alias_for = + let w, preserve_context_sensitivity = categorize alias in + cons (w, Types.ReserveAlias { preserve_context_sensitivity; alias_for }) + + let remove_reserved w = + cons (w, Types.NotReserved) + + let words () = List.rev !conf + +end + +(** Module used to build the intrinsic functions set *) +module INTRINSIC = struct + let intrinsic = ref Reserved_words.default_intrinsics + + let add_intrinsic word = + match kind_of_string word with + | DialectAll -> + intrinsic := StringSet.union Reserved_words.intrinsic_functions !intrinsic + | Word word -> + if not @@ StringSet.mem word Reserved_words.intrinsic_functions then + FATAL.error "Unknown intrinsic function %s" word + else + intrinsic := StringSet.add word !intrinsic + | _ -> Pretty.failwith "Wrong DIALECT-* word" word + + let remove_intrinsic word = + match kind_of_string word with + | DialectAll -> + intrinsic := + StringSet.filter (fun v -> not @@ StringSet.mem v Reserved_words.intrinsic_functions) !intrinsic + | Word word -> + intrinsic := StringSet.remove word !intrinsic + | _ -> Pretty.failwith "Wrong DIALECT-* word" word + + let intrinsic_functions () = !intrinsic +end + +(** Module used to build the system names set *) +module SYSTEM_NAMES = struct + let system_names = ref Reserved_words.default_system_names + + let add_system_name name = + match kind_of_string name with + | DialectAll -> + system_names := StringSet.union Reserved_words.system_names !system_names + | DialectAllDevices -> + system_names := StringSet.union Reserved_words.device_system_names !system_names + | DialectAllSwitches -> + system_names := StringSet.union Reserved_words.switch_system_names !system_names + | DialectAllFeatures -> + system_names := StringSet.union Reserved_words.feature_system_names !system_names + | Word name -> + if StringSet.mem name Reserved_words.system_names then + system_names := StringSet.add name !system_names + else + FATAL.error "Unknown system name: %s" name + + let remove_system_name name = + match kind_of_string name with + | DialectAll -> + system_names := StringSet.diff !system_names Reserved_words.system_names + | DialectAllDevices -> + system_names := StringSet.diff !system_names Reserved_words.device_system_names + | DialectAllSwitches -> + system_names := StringSet.diff !system_names Reserved_words.switch_system_names + | DialectAllFeatures -> + system_names := StringSet.diff !system_names Reserved_words.feature_system_names + | Word name -> + system_names := StringSet.remove name !system_names + + let system_names () = !system_names +end + +(** Module used to build the registers set *) +module REGISTERS = struct + let registers = ref Reserved_words.default_registers + + let add_register register = + match kind_of_string register with + | DialectAll -> + registers := StringSet.union !registers Reserved_words.default_registers + | Word register -> + if not @@ StringSet.mem register Reserved_words.registers then + FATAL.error "Unknown register: %s" register + else + registers := StringSet.add register !registers + | _ -> Pretty.failwith "Wrong DIALECT-* word %S" register + + let remove_register register = + match kind_of_string register with + | DialectAll -> + registers := StringSet.diff !registers Reserved_words.default_registers + | Word register -> + registers := StringSet.remove register !registers + | _ -> Pretty.failwith "Wrong DIALECT-* word %S" register + + let registers () = !registers +end diff --git a/src/lsp/cobol_data/README.md b/src/lsp/cobol_data/README.md new file mode 100644 index 000000000..4e12a3100 --- /dev/null +++ b/src/lsp/cobol_data/README.md @@ -0,0 +1,6 @@ +# Cobol_data package + +This package contains some data structure for COBOL, as well as some logic on the COBOL variables +and values such as `Picture` or `Types`. + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_data/cobol_data.ml b/src/lsp/cobol_data/cobol_data.ml new file mode 100644 index 000000000..a3ad8bba1 --- /dev/null +++ b/src/lsp/cobol_data/cobol_data.ml @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module implements functions to type the COBOL data.*) + +module Types = struct + include Types + type picture = Picture.t + type group = Group.t + + include Compilation_unit.TYPES + type compilation_units = Compilation_unit.SET.t + type +'a compilation_units_map = 'a Compilation_unit.MAP.t +end + +include Env +module Group = Group +module Mangling = Mangling +module Picture = Picture +module Pictured_ast = Pictured_ast +module Qualmap = Qualmap +module Compilation_unit = Compilation_unit +module Typing = Typing diff --git a/src/lsp/cobol_data/compilation_unit.ml b/src/lsp/cobol_data/compilation_unit.ml new file mode 100644 index 000000000..299c6a238 --- /dev/null +++ b/src/lsp/cobol_data/compilation_unit.ml @@ -0,0 +1,80 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open EzCompat + +module TYPES = struct + (** Representation of compilation units *) + type compilation_unit = + { + cu_name: string; + cu_loc: Cobol_common.Srcloc.srcloc; + cu_env: Env.PROG_ENV.t; (* TODO: Env{ironment}.t *) + cu_wss: Group.t list; + } +end +include TYPES + +type t = compilation_unit + +let compare_by_name { cu_name = n1; _ } { cu_name = n2; _ } = + String.compare n1 n2 + +(* --- *) + +module M = struct + type nonrec t = t + let compare = compare_by_name +end + +module SET: sig + include Set.S with type elt = compilation_unit + and type t = Set.Make (M).t + val find_by_name: string -> t -> compilation_unit + val find_at_loc: Cobol_common.Srcloc.srcloc -> t -> compilation_unit + val assoc: (compilation_unit -> 'a) -> t -> 'a Map.Make (M).t + type register = private compilation_unit StringMap.t + val register: t -> register +end = struct + include Set.Make (M) + module MAP = Map.Make (M) + + let find_by_name name cus = + let cu = find_first (fun cu -> String.compare cu.cu_name name >= 0) cus in + if cu.cu_name = name then cu else raise Not_found + let find_at_loc loc cus = + let cu = find_first (fun cu -> Stdlib.compare cu.cu_loc loc >= 0) cus in + if cu.cu_loc = loc then cu else raise Not_found + let assoc f cus = + to_seq cus |> Seq.map (fun cu -> cu, f cu) |> MAP.of_seq + + type register = compilation_unit StringMap.t + let register cus : register = + to_seq cus |> Seq.map (fun cu -> cu.cu_name, cu) |> + StringMap.of_seq + +end + +module MAP: sig + include Map.S with type key = compilation_unit + and type +'a t = 'a Map.Make (M).t + val compilation_units: 'a t -> SET.t + val find_by_name: string -> 'a t -> compilation_unit * 'a +end = struct + include Map.Make (M) + let compilation_units map = + to_seq map |> Seq.map fst |> SET.of_seq + let find_by_name name map = + let cu, v = find_first (fun cu -> String.compare cu.cu_name name >= 0) map in + if cu.cu_name = name then cu, v else raise Not_found +end diff --git a/src/lsp/cobol_data/dune b/src/lsp/cobol_data/dune new file mode 100644 index 000000000..b0e94ac17 --- /dev/null +++ b/src/lsp/cobol_data/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_data) + (public_name cobol_data) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ppx_deriving cobol_parser cobol_ast ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_data)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_data/env.ml b/src/lsp/cobol_data/env.ml new file mode 100644 index 000000000..b8c27146a --- /dev/null +++ b/src/lsp/cobol_data/env.ml @@ -0,0 +1,112 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_ast +open Types + +module StringSet = Cobol_common.Basics.StringSet +module StringMap = Cobol_common.Basics.StringMap +module CharSet = Cobol_common.Basics.CharSet +module FATAL = Cobol_common.Diagnostics.Fatal + +(*FIXME: Quite a bit of rework for c translation and analysis alike *) + +(* For data item: + * name + * type + * declaration loc + * sub_items? + * data_size + * is global + * default value + * picture *) + +(* For program: + * name + * nested_progs (just the name maybe?) + * data_items + * curr_signs (maybe char set) + * decimal_point (maybe algebric) + * entry arguments *) + +module NameSet = Set.Make(struct + type t = name + let compare = String.compare + end) + +module Names = NameSet + +module DATA_ITEM = struct + type condition = { + target: qualname; + values: condition_name_value list; + } [@@deriving show] + + type t = + { name: name; + typ: data_type option; + size: int; + global: bool; + value: data_value_clause option; + renames: qualname list; + condition: condition option; + redefines: qualname option; + constant: constant_value option; } + [@@deriving show] + + let make name = + { name = name; + typ = None; + size = 0; + global = false; + value = None; + renames = []; + redefines = None; + constant = None; + condition = None; } +end + +module PROG_ENV = struct + type t = + { name: name; + parent_prog: t option; + data_items: DATA_ITEM.t Qualmap.t; + currency_signs: CharSet.t; + decimal_point: char; + using_items: NameSet.t; } + + let make ?parent name = + match parent with + | None -> + { name = name; + parent_prog = None; + data_items = Qualmap.empty; + currency_signs = CharSet.empty; + decimal_point = '.'; + using_items = NameSet.empty } + | Some parent -> + { parent with + name = name; + parent_prog = Some parent; + (* CHECKME: directly inherit those? Even better: extract the + non-environment-specific part into a `prog` structure, with a + `prog_env` that is the (inherited and augmented) environment, and + specific `prog_data`/`prog_using`. *) + data_items = Qualmap.empty; + using_items = NameSet.empty } + +end + +module ENV = struct + include StringMap +end diff --git a/src/lsp/cobol_data/group.ml b/src/lsp/cobol_data/group.ml new file mode 100644 index 000000000..5b0388fa9 --- /dev/null +++ b/src/lsp/cobol_data/group.ml @@ -0,0 +1,448 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_ast +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX +open Pictured_ast.Data_sections + +(** This module implements data_groups which are how we group together all the + {!Cobol_parser.Ptree.data_description} in grouped items before typing them. *) + +(*TODO: Maybe renames can be a list of qualnames*) +type t' = + | Renames of {name: name; targets: t list } + | ConditionName of {name: name; values: condition_name_value list; target: t } + | Constant of { name: name; value: constant_value with_loc; + constant_item_descr: constant_item_descr } + | Elementary of { name: name; data_item: data_item_descr } + | Group of { name: name; elements: t list; data_item: data_item_descr } +[@@deriving show] + +and t = t' with_loc +[@@deriving show] + +let pp_data_group_list ppf = + Pretty.list ~fsep:"@ " ~fopen:"@[" ~fclose:"@]" ~fempty:"" + pp ppf + +let name_of: t -> name = fun g -> match ~&g with + | Group {name; _} | Elementary {name; _} | ConditionName {name; _} + | Constant {name; _} | Renames {name; _} -> + name + +(* let name_location g = ~@(name_of g) *) + +(** [group_at_level level acc groups] returns all the groups with the level [level]. The value + returned is of type + {!type:(data_item * condition_name_item list * (data_item * condition_name_item list) list) list} + which represent the group at level [level] and the condition names associated with every entry of + the group and a list of subgroups associated with every item of the group at level [level]. *) +let rec group_at_level level acc (group: working_storage_item_descr list) = + match group with + | [] -> acc + | (Data hd)::tl -> + let conditions, rest = conditions_from [] tl in + let sub_group, rest = subgroup_of [] level rest in + group_at_level level ((hd, conditions, sub_group)::acc) rest + | (CondName cond)::rest -> + begin match acc with + | (hd, conds, sub_group)::tl -> + group_at_level level ((hd, cond::conds, sub_group)::tl) rest + | _ -> invalid_arg "Empty list" + end + | _ -> invalid_arg "Expecting Data or CondName" + +(** [conditions_from acc group] returns a list of condition names and the rest of the group from [group]. *) +and conditions_from acc group = +match group with + | (CondName cond)::tl -> + conditions_from (cond::acc) tl + | _ -> + List.rev acc, group + +(** [subgroup_from acc level group] returns a list of elements that are subordinate to the level + [level] and the rest of the group [group] which is not contained in the current subgroup + (i.e any item following an item of level [level] or lower including the item of level + [level] or lower). *) +and subgroup_of acc curr_level group = + match group with + | [] -> List.rev acc, [] + | (Data ({data_level; _} as hd))::tl -> + if data_level > curr_level then + subgroup_of ((hd, [])::acc) curr_level tl + else + List.rev acc, group + | (CondName cond)::rest -> + begin match acc with + | (hd, conds)::tl -> + subgroup_of ((hd, (cond::conds))::tl) curr_level rest + | _ -> + invalid_arg "Empty list" + end + | _ -> + invalid_arg "Expecting Data or CondName" + +(** [subgroup_of' level group] has the same behavior as [subgroup_of level acc group] but + the [group] is of type {!type:(data_item * condition_name_item list) list} instead of type + {!type:working_storage_item_descr list}*) +let subgroup_of' curr_level (group: (data_item * condition_name_item list) list) = + let rec aux acc curr_level group = + match group with + | [] -> (List.rev acc, []) + | (({data_level; _}, _) as hd)::tl -> + if ~&data_level > ~&curr_level then + aux (hd::acc) curr_level tl + else + List.rev acc, group + in + aux [] curr_level group + +(** [group_at_level' level group] has the same behavior as [group_at_level level acc group] but + the [group] is of type {!type:(data_item * 'a) list} instead of type {!type:working_storage_item_descr list}*) +let group_at_level' level group = + let rec aux acc level group = + match group with + | [] -> acc + | hd::tl -> + let sub_group, rest = subgroup_of' level tl in + aux ((hd, sub_group)::acc) level rest + in + aux [] level group + +(** [make_data_subgroup (module Diags) group] returns a {!t list} from a {!(dde * condition_name list) list} + specifically for groups of levels higher than 1 and different of 77. *) +let make_data_subgroup (module Diags: Cobol_common.Diagnostics.STATEFUL) group = + let rec aux group = + match group with + | [] -> invalid_arg "Empty list" + | (({data_name; _}: data_item) as data_item, cond_names)::[] -> + begin match data_name with + | Some { payload = DataName name; loc } -> + let element = Elementary {name = ~&name; + data_item = Data data_item } &@ loc in + element :: List.map + (fun {condition_name; condition_name_values; _} -> + ConditionName { name = ~&condition_name; + values = condition_name_values; + target = element } &@<- condition_name) + cond_names + | _ -> invalid_arg "Expecting a name" + end + | ({data_level = level; _}, _)::_ -> + let groups = List.rev (group_at_level' level group) in + List.flatten @@ List.map + (fun (({ data_name = name; _ } as data_item, cond_names), sub_groups) -> + match name with + | Some { payload = DataName name; loc } -> + begin match sub_groups with + | [] -> + let element = Elementary { name = ~&name; + data_item = Data data_item } &@ loc in + element:: + (List.map + (fun {condition_name = name; condition_name_values = values; _} -> + ConditionName { name = ~&name; values; + target = element } &@<- name) + cond_names) + | sub_groups -> + let group = Group { name = ~&name; elements = aux sub_groups; + data_item = Data data_item } &@ loc in + group:: + (List.map + (fun {condition_name = name; condition_name_values = values; _} -> + ConditionName {name = ~&name; values; + target = group} &@<- name) + cond_names) + end + | _ -> invalid_arg "Expecting a name") + groups + in + aux group + +(** [make_data_group (module Diags) group] makes a {!(t list, unit) result} from a + {!working_storage_item_descr list} which respect the hierarchy of the list in entry and results + in error if any of the elements of the entry list does not respect the COBOL data groups rules. *) +let make_data_group (module Diags: Cobol_common.Diagnostics.STATEFUL) group = + match (group: working_storage_item_descr list) with (* TODO: with_loc *) + | [Constant {constant_name; constant_value; _} as constant_item_descr] -> + begin match constant_name with + | Some { payload = DataName name; loc } -> + Result.ok [Constant { name = ~&name; + value = constant_value; + constant_item_descr } &@ loc ] + | _ -> + Diags.error "Undefined constant name"; + Result.Error () + end + | [Data { data_name; _ } as data_item] -> + begin match data_name with + | Some { payload = DataName name; loc } -> + Result.ok @@ [Elementary {name = ~&name; data_item } &@ loc ] + | _ -> + Diags.error "Unkown data item"; + Result.Error () + end + | CondName {condition_name = {loc; _}; _}::_ -> + Diags.error ~loc "A@ condition@ name@ must@ follow@ another@ data@ item@ entry"; + Result.Error () + | Data {data_level = level; _} ::_ -> + let same_level_groups = List.rev (group_at_level level [] group) in + List.map + (fun (data_item, cond_names, sub_group) -> + let name = + match data_item.data_name with + | Some {payload = DataName name; _} -> + Result.Ok name + | _ -> + Diags.error "Unnamed data item"; + Result.Error () + in + match sub_group with + | [] -> + Result.map + (fun name -> + let element = Elementary {name = ~&name; + data_item = Data data_item} &@<- name in + element:: + List.map + (fun {condition_name = name; condition_name_values = values; _} -> + ConditionName { name = ~&name; values; + target = element } &@<- name) + cond_names) + name + | lst -> + Result.map + (fun name -> + let group = + Group { name = ~&name; + elements = make_data_subgroup (module Diags) lst; + data_item = Data data_item } &@<- name + in + group:: + (List.map + (fun {condition_name = name; condition_name_values = values; _} -> + ConditionName {name = ~&name; values; + target = group} &@<- name) + cond_names)) + name) + same_level_groups + |> Cobol_common.join_all + |> Result.map List.flatten + | _ -> Result.error () + +(** [group_of_name name group] return a list of groups that are named [name]. *) +let groups_of_name {payload=group_name;_} group = + let rec aux acc group = + match ~&group with + | Elementary {name; _} | Group {name; _} when name = group_name -> + group::acc + | Group {elements; _} -> + List.fold_left aux acc elements + | _ -> + acc + in + aux [] group + +(** [group_of_list name_list groups] returns a list of groups from [groups] whose name correspond to + [name_list], the groups must respect the hierarchy of name list with the following rules: + - [name_list] should be hierarchical with the first value being the lowest level name (i.e level 01 first), + - if [name_list] is empty all the groups from [groups] are returned. *) +let rec groups_of_list name_list groups = + match name_list with + | [] -> groups + | hd::tl -> + let groups = + List.flatten @@ List.fold_left (fun acc group -> + (groups_of_name hd group)::acc) + [] + groups + in + groups_of_list tl groups + +(** [group_range (module Diags) first last group] returns a list of every {!Elementary _} or + {!Group _} which are defined between [first] and [last] (included). + [first] and [last] should be qualified names that are in the form of a list, with + lowest level name first. + [first] should not be the name of any item succeding [last] in the group and [last] should + not be name of any item defined before [first]. + [first] and [last] should be the name of item defined inside [group]. + [first] and [last] should not be ambigious as to which item they define. *) +let group_range (module Diags: Cobol_common.Diagnostics.STATEFUL) first last group = + let rec aux (first, last, first_found, last_found, acc) group = + if first_found && last_found then + first, last, first_found, last_found, acc + else + match ~&group with + | Elementary {name; _} -> + if first_found && not @@ last_found then + let last_found = + match last with + | hd::[] when name = ~&hd -> true + | _ -> false + in + first, last, first_found, last_found, group::acc + else + begin match first with + | hd::[] when name = ~&hd -> + let last_found = + match last with + | hd::[] when name = ~&hd -> true + | _ -> false + in + first, last, true, last_found, group::acc + | _ -> + first, last, first_found, last_found, acc + end + | Group {name; elements; _} -> + if first_found && not last_found then + let last_found = + match last with + | hd::[] when name = ~&hd -> true + | _ -> false + in + match last with + | hd::[] when name = ~&hd -> + List.fold_left aux (first, last, first_found, last_found, acc) elements + | hd::tl when name = ~&hd -> + List.fold_left aux (first, tl, first_found, last_found, acc) elements + | _ -> + first, last, first_found, last_found, group::acc + else + let _, _, first_found, last_found, acc = + (* Fmt.pr "Name: %a, First: %a\n" pp_name name Fmt.(list pp_name) first; *) + let first = + match first with + | hd::tl when name = ~&hd -> + (* Fmt.pr "New first: %a\n" Fmt.(list pp_name) tl; *) + tl + | _ -> first + in + let last = + match last with + | hd::tl when name = ~&hd -> + tl + | _ -> + last + in + List.fold_left aux (first, last, first_found, last_found, acc) elements + in + first, last, first_found, last_found, acc + | _ -> first, last, first_found, last_found, acc + + in + let _, _, _, _, groups = aux (first, last, false, false, []) group in + groups + +(** [make_renames (module Diags) group renames] returns a list of {!(t, unit) result} which + are all of the form [Renames _] and correspond to renaming items from the group [group]. *) +let make_renames (module Diags: Cobol_common.Diagnostics.STATEFUL) group renames = + (* TODO: take `rename with_loc` entries, with more "general" locations *) + List.fold_left begin fun acc { rename_to; rename_renamed; rename_through; _ } -> + match rename_through with + | Some through_name -> + (* TODO: avoid reliance on a list representation. *) + let first = Cobol_ast.list_of_qualname rename_renamed in + let last = Cobol_ast.list_of_qualname through_name in + let groups = + group_range + (module Diags: Cobol_common.Diagnostics.STATEFUL) + first + last + (List.hd group) + in + Ok (Renames {name = ~&rename_to; + targets = List.rev groups} &@<- rename_to) :: acc + | None -> + let name_list = Cobol_ast.list_of_qualname rename_renamed in + let sub_groups = groups_of_list name_list group in + if List.length sub_groups <> 1 then + begin + Diags.error ~loc:~@rename_to "Could not find a unique name to rename."; + Error () :: acc + end + else + let group = List.hd sub_groups in + Ok (Renames {name = ~&rename_to; + targets = [group]} &@<- rename_to) :: acc + end [] renames + +(** [of_working_storage (module Diags) wss] returns the list of groups from wss in a hierarchical + form. *) +let of_working_storage + (module Diags: Cobol_common.Diagnostics.STATEFUL) + (wss: working_storage_item_descr with_loc list) = + let groups = + List.fold_left (fun acc {payload; loc} -> + Result.bind acc (fun acc -> + match (payload: working_storage_item_descr) with + | Constant _ -> + Result.ok @@ ([payload], None)::acc + | Data {data_level = level; _} when ~&level = 1 || ~&level = 77 -> + Result.ok @@ ([payload], None)::acc + | Data _ -> + begin match acc with + | (payload_list, None)::tl -> + Result.ok @@ (payload::payload_list, None)::tl + | (_, Some _)::_ -> + Diags.error ~loc "A@ renames@ entry@ can@ only@ be@ followed@ by@ a@ 01,@ 66,@ 77@ \ + or@ 88@ level@ data@ item."; + Result.Error () + | [] -> + Diags.error ~loc "A@ non@ 01@ or@ 77@ level@ must@ follow@ a@ 01@ level@ data@ item."; + Result.Error () + end + | Renames rename -> + begin match acc with + | (data_list, None)::tl -> + Result.ok @@ (data_list, Some ([rename]))::tl + | (data_list, Some renames)::tl -> + Result.ok @@ (data_list, Some (rename::renames))::tl + | [] -> + Diags.error ~loc "A@ 66@ level@ entry@ must@ follow@ directly@ a@ record@ entry."; + Result.Error () + end + | CondName _ -> + begin match acc with + | (data_list, renames)::tl -> + Result.ok @@ (payload::data_list, renames)::tl + | [] -> + Diags.error ~loc "An@ 88@ level@ entry@ must@ follow@ another@ data@ entry."; + Result.Error () + end)) + (Result.Ok []) + wss + |> Result.map (List.map (fun (data, renames) -> List.rev data, Option.map List.rev renames)) + |> Result.map List.rev + in + Result.bind groups (fun groups -> + Cobol_common.join_all @@ + List.map (fun (group, rename) -> + let group = make_data_group (module Diags) group in + Result.bind group (fun group -> + Option.fold + ~none:[] + ~some:(fun renames -> make_renames (module Diags) group renames) + rename + |> Cobol_common.join_all + |> Result.map (fun renames -> + List.map (function + | { payload = Group {name; elements; data_item}; loc } -> + Group { name; + elements = elements@renames; + data_item } &@ loc + | _ as elem -> + elem) + group))) + groups) + |> Result.map List.flatten diff --git a/src/lsp/cobol_data/group.mli b/src/lsp/cobol_data/group.mli new file mode 100644 index 000000000..0fe6e7a84 --- /dev/null +++ b/src/lsp/cobol_data/group.mli @@ -0,0 +1,45 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module implements a hierarchical version of cobol data items.*) +open Cobol_ast +open Pictured_ast.Data_sections +open Cobol_common.Srcloc.TYPES + +(** The type of hierarchical data items from cobol, used to describe different sections of the + data division such as working storage section or linkage section. *) +type t' = (* TODO: extract `name` *) + | Renames of { name: name; targets: t list } + | ConditionName of { name: name; values: condition_name_value list; target: t } + | Constant of { name: name; value: constant_value with_loc; + constant_item_descr: constant_item_descr } + | Elementary of { name: name; data_item: data_item_descr } + | Group of { name: name; elements: t list; data_item: data_item_descr } +[@@deriving show] + +and t = t' with_loc +[@@deriving show] + +val pp_data_group_list: Format.formatter -> t list -> unit + +(** Extract the name from any kind of data item. *) +val name_of: t -> name + +(* (\** Extract the location of the name of a data group. *\) *) +(* val name_location: t -> srcloc *) + +(** Convert a list of located {!t constant_or_data_descr_entry} to a list of {!t t}*) +val of_working_storage + : (module Cobol_common.Diagnostics.STATEFUL) + -> working_storage_item_descr with_loc list + -> (t list, unit) result diff --git a/src/lsp/cobol_data/index.mld b/src/lsp/cobol_data/index.mld new file mode 100644 index 000000000..ff46d881f --- /dev/null +++ b/src/lsp/cobol_data/index.mld @@ -0,0 +1,10 @@ +{1 Library cobol_data} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package contains data structures for reprensenting COBOL programs and values, as well as some +logic on the COBOL data items and values such ast {!Cobol_data.Picture} or {!Cobol_data.Types}. + +The entry point of this library is the module: {!Cobol_data}. + diff --git a/src/lsp/cobol_data/mangling.ml b/src/lsp/cobol_data/mangling.ml new file mode 100644 index 000000000..7af5f476c --- /dev/null +++ b/src/lsp/cobol_data/mangling.ml @@ -0,0 +1,46 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.INFIX +open Cobol_ast + +exception Not_mangled + +let filler_num = ref 0 + +let new_filler_num () = + let num = !filler_num in + incr filler_num; + num + +let new_filler_string () = + Printf.sprintf "Filler-%u" (new_filler_num ()) + +(* TODO: Here we should employ types instead to describe that the "naming" pass, + if any, has been performed on the AST; just like for picture strings. *) + +(* TODO: Define a type (GADT) where we cannot have (Some Filler) instead. Or + just don't name fillers and refer w.r.t parents in environment. *) + +let mangle_data_name ~default_loc data_name = match data_name with + | Some { payload = DataName _; _ } -> + data_name + | _ -> + let filler_name = new_filler_string () &@ default_loc in + Some (DataName filler_name &@ default_loc) + +let mangled_data_name data_name = match data_name with + | Some { payload = DataName name; _ } -> + ~&name + | _ -> + raise Not_mangled diff --git a/src/lsp/cobol_data/mangling.mli b/src/lsp/cobol_data/mangling.mli new file mode 100644 index 000000000..e43e4621c --- /dev/null +++ b/src/lsp/cobol_data/mangling.mli @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module aims to implement mangling functions for the COBOL AST.*) + + +open Cobol_ast + +(** This exception is raised when a not mangled name is given in a context where it is expected for + the name to be mangled *) +exception Not_mangled + +(** This function mangles an entry name option, by changing every [None] or [Some (Filler)] entries + into [Some (Name "Filler")] where is incremented every time a new [None] or [Some (Filler)] + entry is encountered. It does not change any other [entry_name] value. *) +val mangle_data_name + : default_loc: Cobol_common.Srcloc.srcloc + -> data_name with_loc option + -> data_name with_loc option + +(** This function returns the name as a string if it is in the form of [Some (Name name)] and + raises the [Not_mangled] exception if the pattern of the [entry_name] is different. *) +val mangled_data_name: data_name with_loc option -> string diff --git a/src/lsp/cobol_data/package.toml b/src/lsp/cobol_data/package.toml new file mode 100644 index 000000000..185b1e40c --- /dev/null +++ b/src/lsp/cobol_data/package.toml @@ -0,0 +1,76 @@ + +# name of package +name = "cobol_data" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_ast = "version" +cobol_parser = "version" +ppx_deriving = ">=5.2.1" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/cobol_data/picture.ml b/src/lsp/cobol_data/picture.ml new file mode 100644 index 000000000..e279d0fe6 --- /dev/null +++ b/src/lsp/cobol_data/picture.ml @@ -0,0 +1,1151 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common +open Srcloc.TYPES +module CHARS = Cobol_common.Basics.CharSet + +module TYPES = struct + + type symbol = + | A + | B + | CR + | CS + | DB + | DecimalSep + | E + | GroupingSep + | L + | Minus + | N + | Nine + | One + | P + | Plus + | S + | Slant + | Star + | V + | X + | Z + | Zero + + let pp_symbol ppf = function + | A -> Fmt.char ppf 'A' + | B -> Fmt.char ppf 'B' + | CR -> Fmt.string ppf "CR" + | CS -> Fmt.fmt "currency@ symbol" ppf + | DB -> Fmt.string ppf "DB" + | DecimalSep -> Fmt.fmt "decimal@ point" ppf + | E -> Fmt.char ppf 'E' + | GroupingSep -> Fmt.fmt "grouping@ separator" ppf + | Minus -> Fmt.char ppf '-' + | N -> Fmt.char ppf 'N' + | Nine -> Fmt.char ppf '9' + | One -> Fmt.char ppf '1' + | P -> Fmt.char ppf 'P' + | Plus -> Fmt.char ppf '+' + | L -> Fmt.char ppf 'L' + | S -> Fmt.char ppf 'S' + | Slant -> Fmt.char ppf '/' + | Star -> Fmt.char ppf '*' + | V -> Fmt.char ppf 'V' + | X -> Fmt.char ppf 'X' + | Z -> Fmt.char ppf 'Z' + | Zero -> Fmt.char ppf '0' + + type symbols = + { + symbol: symbol; + symbol_occurences: int; + } + [@@deriving show] + + type editions = + { + basics: basic_edition list; + floating: floating_insertion option; + zerorepl: zero_replacement option; + } + [@@deriving show] + + and basic_edition = + | SimpleInsertion of simple_insertion + | SpecialInsertion of special_insertion + | FixedInsertion of fixed_insertion + + (* The following may later becore mappings from Int to symbols, and even + become abstract to maintain some level of integrity on the integers + involved. *) + and simple_insertion = + { + simple_insertion_symbols: symbols; + simple_insertion_offset: int; + } + + and special_insertion = + { + special_insertion_offset: int; + special_insertion_length: int; + } + + and fixed_insertion = + { + fixed_insertion_symbol: symbol; + fixed_insertion_offset: int; + } + + and floating_insertion = + { + floating_insertion_symbol: symbol; + floating_insertion_ranges: floating_range list; + } + + and zero_replacement = + { + zero_replacement_symbol: symbol; + zero_replacement_ranges: floating_range list; + } + + and floating_range = + { + floating_range_offset: int; + floating_range_length: int; + } + + type category = + | Alphabetic of + { + length: int; + } + | Alphanumeric of + { + length: int; + insertions: simple_insertion list; + } + | Boolean of + { + length: int; + } + | National of + { + length: int; + insertions: simple_insertion list; + } + | FixedNum of + { + digits: int; + scale: int; + with_sign: bool; + editions: editions; + } + | FloatNum of + { + digits: int; + scale: int; + with_sign: bool; + exponent_digits: int; + editions: basic_edition list; + } + + + let pp_category ppf = function + | Alphabetic { length } -> + Fmt.fmt "ALPHABETIC(%u)" ppf length + | Alphanumeric { length; insertions = [] } -> + Fmt.fmt "ALPHANUMERIC(%u)" ppf length + | Alphanumeric { length; insertions = _ } -> + Fmt.fmt "ALPHANUMERIC-EDITED(%u)" ppf length + | Boolean { length } -> + Fmt.fmt "BOOLEAN(%u)" ppf length + | National { length; insertions = [] } -> + Fmt.fmt "NATIONAL(%u)" ppf length + | National { length; insertions = _ } -> + Fmt.fmt "NATIONAL-EDITED(%u)" ppf length + | FixedNum { digits; scale; with_sign; + editions = { basics = []; + floating = None; + zerorepl = None } } -> + Fmt.fmt "NUMERIC(@[digits = %u,@;scale = %d,@;with_sign = %B@])" ppf + digits scale with_sign + | FixedNum { digits; scale; with_sign; editions } -> + Fmt.fmt "NUMERIC-EDITED(@[digits = %u,@;scale = %d,@;\ + with_sign = %B,@;editions = %a@])" ppf + digits scale with_sign pp_editions editions + | FloatNum { digits; scale; with_sign; exponent_digits; editions = [] } -> + Fmt.fmt "FLOAT(@[digits = %u,@;scale = %d,@;exponent_digits = \ + %u,@;with_sign = %B@])" ppf + digits scale exponent_digits with_sign + | FloatNum { digits; scale; with_sign; exponent_digits; editions } -> + Fmt.fmt "FLOAT(@[digits = %u,@;scale = %d,@;exponent_digits = \ + %u,@;with_sign = %B,@;%a@])" ppf + digits scale exponent_digits with_sign + (Fmt.list pp_basic_edition) editions + + + type picture = + { + category: category; + pic: symbols list; + } + [@@deriving show] + + type picture_config = { + max_pic_length : int ; + decimal_char: char ; + currency_signs: Cobol_common.Basics.CharSet.t ; + } + + type error = + | May_only_appear_once of int + | May_not_follow of int * int + | Parenthesis_must_be_preceded_by_picture_symbol + | Unexpected_char of char + | Extraneous_symbol_in_exponent + | Symbol_may_only_appear_once of symbol + | Symbol_must_be_at_start of symbol + | Symbol_must_be_at_end of symbol + | Symbol_must_be_at_start_or_end of symbol + | Symbols_are_mutually_exclusive of symbol * symbol + | Unexpected_symbol of symbol * category option + | Empty_picture_string + | Picture_length_exceeds_limit of (* length *) int * (* max_len *) int + | Missing_symbol_in_exponent + | Missing_digits_in_exponent + | Picture_describes_empty_data_item + | Numeric_item_cannot_exceed_38_digits of int + + module type ENV = sig + val decimal_char: char + val currency_signs: Cobol_common.Basics.CharSet.t + end + +end + +type t = TYPES.picture +[@@deriving show] + +open TYPES + +module Symbol = struct type t = symbol let compare = Stdlib.compare end +module Symbols = Set.Make (Symbol) +module SymbolsMap = Map.Make (Symbol) + +(* --- *) + +let is_edited = function + | Alphabetic _ + | Boolean _ + | Alphanumeric { insertions = []; _ } + | National { insertions = []; _ } + | FixedNum { editions = { basics = []; floating = None; zerorepl = None }; _ } + | FloatNum { editions = []; _ } -> false + | _ -> true + +let data_size: category -> int = function + | Alphabetic { length } + | Boolean { length } + | Alphanumeric { length; _ } -> length + | National { length; _ } -> length * 2 + | FixedNum { digits; _ } -> digits + | FloatNum { digits; exponent_digits; _ } -> digits + exponent_digits + +let edited_size: category -> int = + let simple_insertion_size { simple_insertion_symbols = symbols; _ } = + symbols.symbol_occurences + and special_insertion_size { special_insertion_length = n; _ } = n in + let simple_insertions_size = + List.fold_left (fun s i -> s + simple_insertion_size i) 0 + and basic_editions_size basics = + List.fold_left begin fun s -> function + | SimpleInsertion i -> s + simple_insertion_size i + | SpecialInsertion i -> s + special_insertion_size i + | FixedInsertion _ -> s + 1 + end 0 basics + in + let editions_size { basics; floating; _ } = + basic_editions_size basics + if floating = None then 0 else 1 + in + function + | Alphabetic { length } + | Boolean { length } -> + length + | Alphanumeric { length; insertions } -> + length + + simple_insertions_size insertions + | National { length; insertions } -> + length * 2 + + simple_insertions_size insertions + | FixedNum { digits; with_sign; editions; _ } -> + digits + editions_size editions + + if with_sign then 1 else 0 (* WARNING: depends on SIGN/SEPARATE phrase *) + | FloatNum { digits; exponent_digits; editions; _ } -> + digits + exponent_digits + basic_editions_size editions + +let size = edited_size + +(* --- *) + +(* NOTE: During construction edition lists in categories are in reversed + order. *) + +let reverse_editions = + let reverse_floating { floating_insertion_symbol; + floating_insertion_ranges } = + { floating_insertion_symbol; + floating_insertion_ranges = List.rev floating_insertion_ranges } + and reverse_zerorepl { zero_replacement_symbol; + zero_replacement_ranges } = + { zero_replacement_symbol; + zero_replacement_ranges = List.rev zero_replacement_ranges } + in + function + | Alphabetic _ | Boolean _ as c -> + c + | Alphanumeric { length; insertions } -> + Alphanumeric {length; insertions = List.rev insertions } + | National { length; insertions } -> + National {length; insertions = List.rev insertions } + | FixedNum { digits; scale; with_sign; + editions = { basics; floating; zerorepl } } -> + let basics = List.rev basics + and floating = Option.map reverse_floating floating + and zerorepl = Option.map reverse_zerorepl zerorepl in + FixedNum { digits; scale; with_sign; + editions = { basics; floating; zerorepl } } + | FloatNum { digits; scale; with_sign; exponent_digits; editions } -> + FloatNum { digits; scale; with_sign; exponent_digits; + editions = List.rev editions } + + + + +let as_simple_insertions = function + | { floating = Some _; _ } -> + raise Exit + | { basics; _ } -> + List.map begin function + | SimpleInsertion i -> i + | SpecialInsertion _ + | FixedInsertion _ -> raise Exit + end basics + + +let append_insertion ({ basics; floating; _ } as editions) symbols offset = + let has_any_fixed_insertion = + List.exists (function FixedInsertion _ -> true | _ -> false) + in + let rec previous_fixed_insertion acc = function + | [] -> + Ok None + | FixedInsertion { fixed_insertion_symbol = s; + fixed_insertion_offset = o } :: tl + when s = symbols.symbol -> + if has_any_fixed_insertion acc + then Error () (* no fixed insertion is allowed in floating string *) + else Ok (Some (o, List.rev_append acc tl)) + | i :: tl -> + previous_fixed_insertion (i :: acc) tl + in + let new_range = { floating_range_offset = offset; + floating_range_length = symbols.symbol_occurences } in + match floating with + | Some { floating_insertion_symbol = s; + floating_insertion_ranges = ranges } + when s = symbols.symbol -> + let editions = + { editions with + floating = Some { floating_insertion_symbol = s; + floating_insertion_ranges = new_range :: ranges } } + in + Ok (editions, symbols.symbol_occurences) (* all symbols count as digits *) + | _ + when symbols.symbol_occurences = 1 -> (* fixed insertion with a priori + non-floating symbol *) + let editions = (* (further checked in check_editions) *) + { editions with + basics = FixedInsertion { fixed_insertion_symbol = symbols.symbol; + fixed_insertion_offset = offset } :: basics } + in + Ok (editions, 0) (* no more digit *) + | Some _ -> (* invalid floating insertion with new symbol *) + Error () + | None -> + match previous_fixed_insertion [] basics with + | Ok None -> + let editions = + { editions with + floating = Some { floating_insertion_symbol = symbols.symbol; + floating_insertion_ranges = [new_range] } } + in + Ok (editions, symbols.symbol_occurences - 1) + | Ok (Some (previous_offset, basics)) -> + let old_range = { floating_range_offset = previous_offset; + floating_range_length = 1 } in + let editions = + { editions with + basics; + floating = Some { floating_insertion_symbol = symbols.symbol; + floating_insertion_ranges = [new_range; + old_range] } } + in + Ok (editions, symbols.symbol_occurences) + | Error () -> + Error () + + +let append_zero_replacement ({ zerorepl; _ } as editions) symbols offset = + let new_range = { floating_range_offset = offset; + floating_range_length = symbols.symbol_occurences } in + match zerorepl with + | None -> + Ok { editions with + zerorepl = Some { zero_replacement_symbol = symbols.symbol; + zero_replacement_ranges = [new_range] } } + | Some { zero_replacement_symbol = s; + zero_replacement_ranges = ranges } + when s = symbols.symbol -> + Ok { editions with + zerorepl = Some { zero_replacement_symbol = s; + zero_replacement_ranges = new_range :: ranges } } + | Some _ -> + Error () + + +let append category ~after_v ({ symbol; symbol_occurences = n } as symbols) = + let error = Result.Error (category, symbol) in + let alphanum length insertions = + Ok (Alphanumeric { length; insertions }) + and numeric + ?(with_sign = false) + ?(editions = { basics = []; floating = None; zerorepl = None }) + digits scale = + FixedNum { digits; scale; with_sign; editions } + and float + ?(with_sign = false) + ?(editions = []) + digits scale exponent_digits = + FloatNum { digits; scale; with_sign; exponent_digits; editions } + in + let append_A = function + | Alphabetic { length } -> + Ok (Alphabetic { length = length + n }) + | Alphanumeric { length; insertions } -> + Ok (Alphanumeric { length = length + n; insertions }) + | FixedNum { digits; scale = 0; with_sign = false; editions } -> + (try alphanum (digits + n) (as_simple_insertions editions) + with Exit -> error) (* 'cause of non-simple insertions *) + | _ -> error + and append_9 = function + | Alphabetic { length } -> + alphanum (length + n) [] + | Alphanumeric { length; insertions } -> + alphanum (length + n) insertions + | FixedNum { digits; scale; with_sign; editions } -> + Ok (numeric (digits + n) (if after_v then scale + n else scale) + ~with_sign ~editions) + | FloatNum { digits; scale; with_sign; exponent_digits; editions } -> + Ok (float digits scale (exponent_digits + n) ~with_sign ~editions) + | _ -> error + and append_X = function + | Alphabetic { length } -> + alphanum (length + n) [] + | Alphanumeric { length; insertions } -> + alphanum (length + n) insertions + | FixedNum { digits; scale = 0; with_sign = false; editions } -> + (try alphanum (digits + n) (as_simple_insertions editions) + with Exit -> error) + | _ -> error + and append_P = function + | FixedNum { digits; scale; with_sign; editions } -> + Ok (numeric ~with_sign ~editions + (digits + n) + (scale + if digits = 0 then n else - n)) + | _ -> error + and append_simple_insertion = + let simple_insertion c = + { simple_insertion_symbols = symbols; + simple_insertion_offset = size c } + in + function + | Alphabetic { length } as c -> + alphanum length [simple_insertion c] + | Alphanumeric { length; insertions } as c -> + alphanum length (simple_insertion c :: insertions) + | FixedNum { digits; scale; with_sign; editions } as c -> + let editions = + { editions with + basics = SimpleInsertion (simple_insertion c) :: editions.basics } in + Ok (numeric ~with_sign ~editions digits scale) + | _ -> error + and append_fixed_or_floating_insertion = function + | FixedNum { digits; scale; with_sign; editions } as c + when not with_sign || digits > 0 -> (* forbidden in between S and digits *) + (match append_insertion editions symbols (edited_size c) with + | Ok (editions, digits') -> + let digits = digits + digits' + and scale = if after_v then scale + digits' else scale in + Ok (numeric ~with_sign ~editions digits scale) + | Error () -> error) + | _ -> error + and append_special_insertion offset = function + | FixedNum { digits; scale; with_sign; editions } -> + let special = SpecialInsertion { special_insertion_offset = offset; + special_insertion_length = n } in + Ok (numeric ~with_sign digits scale + ~editions:{ editions with basics = special :: editions.basics }) + | _ -> error + and append_zero_replacement = function + | FixedNum { digits; scale; with_sign; editions } as c -> + (match append_zero_replacement editions symbols (edited_size c) with + | Ok editions -> + let digits = digits + n + and scale = if after_v then scale + n else scale in + Ok (numeric ~with_sign ~editions digits scale) + | Error () -> error) + | _ -> error + and append_E = function + | FixedNum { digits; scale; with_sign; + editions = { basics; floating = None; zerorepl = None } } -> + Ok (float digits scale 0 ~with_sign ~editions:basics) + | _ -> error + in + (* TODO: always numeric-edited when BLANK WHEN ZERO *) + match category, symbol with + | None, (A | L) -> + Ok (Alphabetic { length = n }) + | None, X -> + Ok (Alphanumeric { length = n; insertions = [] }) + | None, One -> + Ok (Boolean { length = n }) + | None, N -> + Ok (National { length = n; insertions = [] }) + | None, Nine -> + Ok (numeric n 0) + | None, S -> + Ok (numeric 0 0 ~with_sign:true) + | None, V -> + Ok (numeric 0 0) + | None, P -> + Ok (numeric n n) + | None, (Zero | B | Slant) -> (* default to numeric if prefix *) + append_simple_insertion (numeric 0 0) + | None, GroupingSep -> (* simple insertion *) + append_simple_insertion (numeric 0 0) + | None, (CS | Plus | Minus | CR | DB) -> (* fixed or floating insertion *) + append_fixed_or_floating_insertion (numeric 0 0) + | None, DecimalSep -> (* special insertion *) + append_special_insertion 0 (numeric 0 0) + | None, (Z | Star) -> + append_zero_replacement (numeric 0 0) + | Some c, A -> + append_A c + | Some c, X -> + append_X c + | Some (Boolean { length }), One -> + Ok (Boolean { length = length + n }) + | Some (National { length; insertions }), N -> + Ok (National { length = length + n; insertions }) + | Some c, Nine -> + append_9 c + | Some c, P -> + append_P c + | Some (FixedNum _ as c), V when not after_v -> + Ok c + | Some c, E -> + append_E c + | Some (FloatNum { exponent_digits = 0; _ } as c), Plus -> + (* NOTE: that + seems to be mandatory according to ISO/IEC 2014; this is + checked at (E+ check) below. *) + Ok c + | Some c, (Zero | B | Slant) -> + append_simple_insertion c + | Some c, GroupingSep -> (* simple insertion *) + append_simple_insertion c + | Some c, (CS | Plus | Minus | CR | DB) -> (* fixed insertion *) + append_fixed_or_floating_insertion c + | Some c, DecimalSep -> (* special insertion *) + append_special_insertion (edited_size c) c + | Some c, (Z | Star) -> + append_zero_replacement c + | _ -> + error + +exception INVALIDCHAR of char + +let symbol_of_char config c = + match c with + | c when CHARS.mem c config.currency_signs -> CS + | '.' | ',' as c when c == config.decimal_char -> DecimalSep + | '.' | ',' -> GroupingSep + | '*' -> Star + | '+' -> Plus + | '-' -> Minus + | '/' -> Slant + | '0' -> Zero + | '1' -> One + | '9' -> Nine + | 'A' -> A + | 'B' -> B + | 'E' -> E + | 'L' -> L + | 'N' -> N + | 'P' -> P + | 'S' -> S + | 'V' -> V + | 'X' -> X + | 'Z' -> Z + | c -> raise @@ INVALIDCHAR c + + let symbol_precedence_index + ~max_idx ~after_v ~after_e ~idx ~zero_suppress_or_floating_insert + : symbol -> int = function + | B | Zero | Slant -> 0 + | GroupingSep -> 1 + | DecimalSep -> 2 + | Plus when after_e -> 3 + | Plus | Minus when not zero_suppress_or_floating_insert && idx < max_idx -> 4 + | Plus | Minus when not zero_suppress_or_floating_insert -> 5 + | CR | DB -> 6 + | CS when not zero_suppress_or_floating_insert && idx < 2 -> 7 + | CS when not zero_suppress_or_floating_insert -> 8 + | Z | Star when not after_v -> 9 + | Z | Star -> 10 + | Plus | Minus when not after_v -> 11 + | Plus | Minus -> 12 + | CS when not after_v -> 13 + | CS -> 14 + | Nine -> 15 + | A | X -> 16 + | L -> 17 + | S -> 18 + | V -> 19 + | P when not after_v -> 20 + | P -> 21 + | One -> 22 + | N -> 23 + | E -> 24 + +let precedence_table = + (* An 'x' indicates that the symbol in the colon may precede the symbol of the + row. + B , . + + + CR cs cs Z Z + + cs cs 9 A L S V P P 1 N E + 0 - - DB * * - - X + / *) + Array.map (fun xs -> Array.init 25 (fun i -> xs.[i * 3 + 1] = 'x')) [| + " x x x x x x x x x x x x x x x x "; + " x x x x x x x x x x x x x x "; + " x x x x x x x x "; + " x "; + " "; + " x x x x x x x x x x x x x "; + " x x x x x x x x x x x x x "; + " x "; + " x x x x x x x x x x "; + " x x x x x "; + " x x x x x x x x x "; + " x x x x "; + " x x x x x x x "; + " x x x x "; + " x x x x x x x "; + " x x x x x x x x x x x x x x x x "; + " x x x x "; + " "; + " "; + " x x x x x x x x x x "; + " x x x x x x x x x x "; + " x x x x x "; + " x "; + " x x "; + " x x x x x "; + |] + +exception BREAK of int (* Internal exception *) + + +let char_order_checker_for_pic_string () = + (* From GnuCOBOL, itself inspired by the standard's way of specifying + precedence. *) + let seen = Array.make 25 false in + let check_char_order symbol_precedence = + try + Array.iteri begin fun i -> function + | false when seen.(i) -> raise @@ BREAK i + | _ -> () + end precedence_table.(symbol_precedence); + seen.(symbol_precedence) <- true; + Ok () + with BREAK prev_precedence -> + seen.(symbol_precedence) <- true; + let diag = + if symbol_precedence = prev_precedence then + May_only_appear_once symbol_precedence + else + May_not_follow ( symbol_precedence, prev_precedence ) + in + Error diag + in + let reset () = + Array.(fill seen 0 (length seen) false) + in + check_char_order, reset + + (* Maybe not in ISO/IEC 2014: Z/CS, B/* *) +let mutual_exclusions = + SymbolsMap.of_seq @@ List.to_seq [ + B, Symbols.singleton Star; + CS, Symbols.singleton Z; + DecimalSep, Symbols.of_list [P; V]; + P, Symbols.singleton DecimalSep; + Star, Symbols.of_list [Z; B]; + V, Symbols.singleton DecimalSep; + Z, Symbols.of_list [Star; CS]; + ] + + type exp_sequence_state = + | ExpNone + | ExpWaitingPlus + | ExpWaitingDigits + + type acc = + { + v_idx: int option; (* Some _ => V, P, or DecimalSep \in seen *) + e_idx: int option; + seen: Symbols.t; (* Records only some symbols *) + exp_sequence: exp_sequence_state; + errors: ( error * (int*int)) list ; + } + + let with_error acc loc error = { acc with errors = (error, loc) :: acc.errors } + + module SCANNING = struct + type 'a string_parser = string -> 'a + + let mk_parser spec cstr : _ string_parser = fun str -> + Scanf.sscanf str spec cstr + + let try_parse (specs: 'a string_parser list) str pos len = + let str = String.sub str pos (len-pos) in + let rec try_parse = function + | [] -> None + | f :: tl -> try Some (f str) with + | End_of_file | Scanf.Scan_failure _ -> try_parse tl + in + try_parse specs + + + let single symbol = + { symbol; symbol_occurences = 1 } + + let rec pic_symbol ?expect ~config s pos len = + + let lookahead c n l suff = + let pos = len - String.length suff in + let c = Char.uppercase_ascii c in + let symbol = symbol_of_char config c in + match expect with + | Some cc when cc <> c -> + { symbol; symbol_occurences = n }, l + | _ -> + (* look ahead for further occurences *) + match pic_symbol ~expect:c ~config s pos len with + | Some ({ symbol = s'; symbol_occurences = n' }, l') + when s' = symbol -> + { symbol; symbol_occurences = n + n' }, l' + l + | _ -> + { symbol; symbol_occurences = n }, l + | exception INVALIDCHAR _ -> (* delay for better location *) + { symbol; symbol_occurences = n }, l + in + if pos = len then + None + else + try_parse [ + (* NOTE: those scanners allow spaces to be inserted in PICTURE + strings; this should be ok as parsed tokens should contain no + space characters; plus this may allow more readable string + internally. *) + mk_parser "CR%s%!" (fun _suff -> single CR, 2); + mk_parser "DB%s%!" (fun _suff -> single DB, 2); + mk_parser "%c(%u)%n%s%!" lookahead; + mk_parser "%c%s%!" (fun c -> lookahead c 1 1) + ] s pos len + + + end + + +let of_string config str = + + let len = String.length str in + let next_symbols pos acc = + (* Lookup and characterize next sequence of consecutive characters: *) + match SCANNING.pic_symbol ~config str pos len with + | None when pos = len -> (* end of PICTURE string *) + None, acc + | None -> + None, + let c = str.[pos] in + if c = '(' + then with_error acc (pos,1) + Parenthesis_must_be_preceded_by_picture_symbol + else with_error acc (pos,1) ( Unexpected_char c ) + | Some (symbols, span) -> + let pos' = pos + span in + Some (symbols, (pos,span), pos'), acc + | exception INVALIDCHAR c -> + None, + with_error acc (pos, 1) ( Unexpected_char c ) + in + + let rec of_string_rec acc category pic idx pos = + match next_symbols pos acc with + | None, acc -> + category, pic, acc, idx - 1 (* all done *) + | Some ( symbols, (_, span as loc), pos' ), acc -> + let after_v = acc.v_idx <> None in + let acc, ok = match check_occurences acc symbols loc with + | Ok acc -> acc, true + | Error acc -> acc, false + in + let acc, ok = match check_positions acc symbols loc idx pos' with + | Ok acc -> acc, ok + | Error acc -> acc, false + in + let acc, ok = match check_mutual_exclutions acc symbols loc with + | Ok acc -> acc, ok + | Error acc -> acc, false + in + if ok then + let category = append ~after_v category symbols in + let acc = match symbols.symbol with + | V | DecimalSep when acc.v_idx = None -> + { acc with v_idx = Some idx } + | P when acc.v_idx = None -> + let v_idx = match category with + | Ok c | Error (Some c, _) + when data_size c = symbols.symbol_occurences -> idx - 1 + | Error (None, _) -> idx - 1 + | _ -> idx + symbols.symbol_occurences + in + { acc with v_idx = Some v_idx } + | E -> + { acc with e_idx = Some idx; exp_sequence = ExpWaitingPlus } + | Plus when acc.exp_sequence = ExpWaitingPlus -> + { acc with exp_sequence = ExpWaitingDigits } + | Plus when acc.exp_sequence = ExpWaitingDigits -> + with_error acc loc Extraneous_symbol_in_exponent + | _ -> + acc + in + check acc ~loc category (symbols :: pic) (idx + span) pos' + else (* skip symbol(s) *) + of_string_rec acc category pic (idx + span) pos' + + and check_occurences acc symbols loc = + match symbols.symbol with (* check occurences *) + | CR | DB | E | S | V | L | DecimalSep as s -> + if Symbols.mem s acc.seen || symbols.symbol_occurences > 1 + then Error ( with_error acc loc ( Symbol_may_only_appear_once s ) ) + else Ok { acc with seen = Symbols.add s acc.seen } + | P | Z | Star |CS | B as s -> (* record for mutual exclutions *) + Ok { acc with seen = Symbols.add s acc.seen } + | _ -> + Ok acc + + and check_positions acc symbols loc idx pos = + match symbols.symbol with (* check for some positions (quite ad hoc) *) + | L | S as s when idx <> 0 -> + Error ( with_error acc loc ( Symbol_must_be_at_start s ) ) + | CR | DB as s when pos < len -> + Error ( with_error acc loc ( Symbol_must_be_at_end s ) ) + | P when idx = 0 || + idx = 1 && Symbols.(mem S acc.seen || mem V acc.seen) || + idx = 2 && Symbols.(mem S acc.seen && mem V acc.seen) || + pos = len || String.sub str pos (len-pos) = "V" -> + Ok acc + | P as s -> + Error ( with_error acc loc ( Symbol_must_be_at_start_or_end s )) + | _ -> + Ok acc + + and check_mutual_exclutions acc symbols loc = + match SymbolsMap.find_opt symbols.symbol mutual_exclusions with + | None -> + Ok acc + | Some set -> + let violations = Symbols.inter set acc.seen in + if Symbols.is_empty violations then Ok acc else + Result.error @@ Symbols.fold ( fun s acc -> + with_error acc loc ( Symbols_are_mutually_exclusive ( symbols.symbol, s )) + ) violations acc + + and check acc ~loc category' pic idx suff = + match category' with + | Ok category -> + of_string_rec acc (Some category) pic idx suff + | Error (c, s) -> + c, pic, + with_error acc loc ( Unexpected_symbol (s, c)), + idx - 1 + in + let category, pic, acc, max_idx = + of_string_rec { + v_idx = None; + e_idx = None; + exp_sequence = ExpNone; + seen = Symbols.empty; + errors = []; + } None [] 0 0 + in + let loc = (0, len) in + (* Last remaining checks; global checks should come here. *) + let acc = match pic with + | [] -> + with_error acc loc Empty_picture_string + | _ when len > config.max_pic_length -> + with_error acc loc + ( Picture_length_exceeds_limit ( len, config.max_pic_length )) + | _ -> acc + in + + let acc = match acc.exp_sequence with (* (E+ check) *) + | ExpWaitingPlus -> + with_error acc loc Missing_symbol_in_exponent + | _ -> acc + in + let acc = match category with + | Some (FloatNum { exponent_digits = 0; _ }) -> + with_error acc loc Missing_digits_in_exponent + | _ -> acc + in + + let acc = match Option.map (fun c -> c, data_size c) category with + | None -> + acc + | Some (_, 0) -> + (* In GnuCOBOL, note the `U` in: "PICTURE string must contain at least + one of the set A, N, U, X, Z, 1, 9 and *; or at least two of the + set +, - and the currency symbol" *) + with_error acc loc Picture_describes_empty_data_item + | Some ((FixedNum _ | FloatNum _), data_size) when data_size > 38 -> + with_error acc loc ( Numeric_item_cannot_exceed_38_digits data_size ) + | _ -> acc + in + + let pic = List.rev pic in + + let _, acc = + (* Check precedence rules w.r.t the standards. This also ensures some + form of well-formedness of the editions. *) + let symbol_precedence_index = symbol_precedence_index ~max_idx in + let check_char_order, reset = char_order_checker_for_pic_string () in + let floating_symbolp = match category with + | Some (FixedNum { editions = { floating = Some f; _ }; _ }) -> + fun p -> p = f.floating_insertion_symbol + | _ -> + fun _ -> false + in + List.fold_left begin fun (idx, acc) { symbol; symbol_occurences = n } -> + if symbol = E then reset (); (* consider exponent string separately *) + let prec idx = + symbol_precedence_index symbol ~idx + ~after_v:(Option.fold ~some:(fun i -> idx > i) ~none:false acc.v_idx) + ~after_e:(Option.fold ~some:(fun i -> idx > i) ~none:false acc.e_idx) + ~zero_suppress_or_floating_insert:(floating_symbolp symbol) + in + let acc = + match check_char_order (prec idx) with + | Error diag -> with_error acc loc diag + | Ok () when n = 1 -> acc + | Ok () -> (* check twice on repeated symbols *) + match check_char_order (prec (idx + n - 1)) with + | Error diag -> with_error acc loc diag + | Ok () -> acc + in + idx + n, acc + end (0, acc) pic + in + + let pic = + let default = Alphanumeric { length = 0; insertions = [] } in + { + category = Option.fold ~some:reverse_editions ~none:default category; + pic; + } + in + match acc.errors with + | [] -> Ok pic + | errors -> Error ( errors, pic ) + + +let pp_meaning_of_precedence_index config ppf = function + | 0 -> Fmt.pf ppf "B, 0 or /" + | 1 -> Fmt.pf ppf "grouping@ separator ('%c')" + (if config.decimal_char = '.' then ',' else '.') + | 2 -> Fmt.pf ppf "decimal@ point ('%c')" config.decimal_char + | 3 -> Fmt.pf ppf "the sign of floating exponent" + | 4 -> Fmt.pf ppf "a leading +/- sign" + | 5 -> Fmt.pf ppf "a trailing +/- sign" + | 6 -> Fmt.pf ppf "CR or DB" + | 7 -> Fmt.pf ppf "a leading currency symbol" + | 8 -> Fmt.pf ppf "a trailing currency symbol" + | 9 -> Fmt.pf ppf "a Z or * which is before the decimal point" + | 10 -> Fmt.pf ppf "a Z or * which is after the decimal point" + | 11 -> Fmt.pf ppf "a floating +/- string which is before the decimal point" + | 12 -> Fmt.pf ppf "a floating +/- string which is after the decimal point" + | 13 -> Fmt.pf ppf "a floating currency symbol string which is before the \ + decimal point" + | 14 -> Fmt.pf ppf "a floating currency symbol string which is after the \ + decimal point" + | 15 -> Fmt.pf ppf "9" + | 16 -> Fmt.pf ppf "A or X" + | 17 -> Fmt.pf ppf "L" + | 18 -> Fmt.pf ppf "S" + | 19 -> Fmt.pf ppf "V" + | 20 -> Fmt.pf ppf "a P which is before the decimal point" + | 21 -> Fmt.pf ppf "a P which is after the decimal point" + | 22 -> Fmt.pf ppf "1" + | 23 -> Fmt.pf ppf "N" + | 24 -> Fmt.pf ppf "E" + | _ as d -> Fmt.pf ppf "an unkown character of value: %d" d + +let pp_error ~config ppf error = + match error with + | May_only_appear_once symbol_precedence -> + Format.fprintf ppf + "%a@ may@ only@ appear@ once@ in@ a@ PICTURE@ string" + (pp_meaning_of_precedence_index config) symbol_precedence + | May_not_follow ( symbol_precedence, prev_precedence ) -> + Format.fprintf ppf + "%a@ may@ not@ follow@ %a" + (pp_meaning_of_precedence_index config) symbol_precedence + (pp_meaning_of_precedence_index config) prev_precedence + | Parenthesis_must_be_preceded_by_picture_symbol -> + Format.fprintf ppf + "Parenthesis@ must@ be@ preceded@ by@ a@ picture@ symbol" + | Unexpected_char c -> + Format.fprintf ppf + "Unexpected@ character@ %c@ in@ PICTURE@ string" c + | Extraneous_symbol_in_exponent -> + Format.fprintf ppf "Extraneous@ +@ symbol(s)@ in@ exponent" + | Symbol_may_only_appear_once s -> + Format.fprintf ppf "%a@ may@ only@ occur@ once@ in@ a@ \ + PICTURE@ string" pp_symbol s + | Symbol_must_be_at_start s -> + Format.fprintf ppf "%a@ must@ be@ at@ start@ of@ PICTURE@ string" + pp_symbol s + | Symbol_must_be_at_end s -> + Format.fprintf ppf "%a@ must@ be@ at@ end@ of@ PICTURE@ string" + pp_symbol s + | Symbol_must_be_at_start_or_end s -> + Format.fprintf ppf + "%a@ must@ be@ at@ start@ or@ end@ of@ PICTURE@ string" + pp_symbol s + | Symbols_are_mutually_exclusive ( s1, s2 ) -> + Format.fprintf ppf "%a@ and@ %a@ are@ mutually@ exclusive@ in@ a@ \ + PICTURE@ string" + pp_symbol s1 pp_symbol s2 + | Unexpected_symbol (s, c) -> + Format.fprintf ppf "Unexpected@ %a@ in@ PICTURE@ string%a" + pp_symbol s + Fmt.(option (fun ppf -> fmt "@ of@ category@ %a" ppf pp_category)) + (Option.map reverse_editions c) + | Empty_picture_string -> + Format.fprintf ppf "Empty@ PICTURE@ string" + | Picture_length_exceeds_limit ( len, max_length ) -> + Format.fprintf ppf + "length@ of@ PICTURE@ string@ exeeds@ allowed@ size@ (max@ length:@ \ + %d,@ given@ length:%d)" max_length len + | Missing_symbol_in_exponent -> + Format.fprintf ppf "Missing@ +@ symbol@ in@ exponent" + | Missing_digits_in_exponent -> + Format.fprintf ppf "Missing@ digits@ in@ exponent" + | Picture_describes_empty_data_item -> + Format.fprintf ppf + "PICTURE@ string@ describes@ an@ empty@ data@ item" + | Numeric_item_cannot_exceed_38_digits len -> + Format.fprintf ppf + "Numeric@ item@ cannot@ be@ longer@ than@ 38@ digits, %d found" len + +module Make (Config: Cobol_config.T) (Env: ENV) = struct + + module DIAGS = Cobol_common.Diagnostics + + let add_diag acc ~loc fmt = + DIAGS.kerror ~loc (fun diag -> DIAGS.Set.cons diag acc ) fmt + + let add_hint acc ~loc fmt = + DIAGS.khint ~loc (fun diag -> DIAGS.Set.cons diag acc ) fmt + + let add_diags acc ~loc ~config error = + let acc = add_diag acc ~loc "%a" (pp_error ~config) error in + match error with + | Picture_describes_empty_data_item -> + add_hint acc ~loc + "PICTURE@ string@ must@ contain@ at@ least@ one@ of@ \ + the@ set@ A,@ N,@ X,@ Z,@ 1,@ 9@ and@ *;@ or@ at@ \ + least@ two@ of@ the@ set@ +,@ -@ and@ the@ currency@ \ + symbol" + | _ -> acc + + exception InvalidPicture of + string with_loc * Cobol_common.Diagnostics.diagnostics * picture + + let of_string ( { payload ; loc } as str ) = + + let config = { + max_pic_length = Config.pic_length#value ; + decimal_char = Env.decimal_char ; + currency_signs = Env.currency_signs ; + } in + match of_string config payload with + | Error ( errors, pic ) -> + let diags = List.fold_left (fun acc ( error, (pos,len) ) -> + let loc = Srcloc.sub loc ~pos ~len in + add_diags acc ~loc ~config error) DIAGS.Set.none errors + in + raise @@ InvalidPicture (str, diags, pic) + | Ok pic -> { payload = pic ; loc } + +end + + +let config = { max_pic_length = 100; decimal_char = '.' ; + currency_signs = CHARS.add '$' CHARS.empty } + +let unit_test ?(config=config) ~expect picture = + let ppf = Format.str_formatter in + begin + match of_string config picture with + | Ok pic -> + pp_picture ppf pic ; + | Error ( errors, _ ) -> + List.iter (fun ( error, (pos,len) )-> + Format.fprintf ppf "Loc: %d (%d)@." pos len; + pp_error ~config ppf error; + Format.fprintf ppf "@."; + ) errors + end; + let res = Format.flush_str_formatter () in + if res <> expect then begin + Printf.eprintf "Unit test %S failed:\n%!" picture; + Printf.eprintf " Result:\n"; + Printf.eprintf "{|%s|} ;\n" res; + Printf.eprintf " Expected:\n"; + Printf.eprintf "{|%s|} ;\n%!" expect; + false + end + else + true diff --git a/src/lsp/cobol_data/picture.mli b/src/lsp/cobol_data/picture.mli new file mode 100644 index 000000000..c21d93a77 --- /dev/null +++ b/src/lsp/cobol_data/picture.mli @@ -0,0 +1,213 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES + +(* --- *) + +module TYPES: sig + type symbol = + | A + | B + | CR + | CS + | DB + | DecimalSep + | E + | GroupingSep + | L + | Minus + | N + | Nine + | One + | P + | Plus + | S + | Slant + | Star + | V + | X + | Z + | Zero + + type symbols = + { + symbol: symbol; + symbol_occurences: int; + } + + type category = + | Alphabetic of + { + length: int; + } + | Alphanumeric of + { + length: int; + insertions: simple_insertion list; + } + | Boolean of + { + length: int; + } + | National of + { + length: int; + insertions: simple_insertion list; + } + | FixedNum of + { + digits: int; + scale: int; + with_sign: bool; + editions: editions; + } + | FloatNum of + { + digits: int; + scale: int; + with_sign: bool; + exponent_digits: int; + editions: basic_edition list; + } + + and editions = + { + basics: basic_edition list; + floating: floating_insertion option; + zerorepl: zero_replacement option; + } + + and basic_edition = + | SimpleInsertion of simple_insertion + | SpecialInsertion of special_insertion + | FixedInsertion of fixed_insertion + + and simple_insertion = + { + simple_insertion_symbols: symbols; + simple_insertion_offset: int; + } + + and special_insertion = + { + special_insertion_offset: int; + special_insertion_length: int; + } + + and fixed_insertion = + { + fixed_insertion_symbol: symbol; + fixed_insertion_offset: int; + } + + and floating_insertion = + { + floating_insertion_symbol: symbol; + floating_insertion_ranges: floating_range list; + } + + and zero_replacement = + { + zero_replacement_symbol: symbol; + zero_replacement_ranges: floating_range list; + } + + and floating_range = + { + floating_range_offset: int; + floating_range_length: int; + } + + val pp_category: category Pretty.printer + + type picture = + { + category: category; + pic: symbols list; + } + [@@deriving show] + + type picture_config = { + max_pic_length : int ; + decimal_char: char ; + currency_signs: Cobol_common.Basics.CharSet.t ; + } + + type error = + | May_only_appear_once of int + | May_not_follow of int * int + | Parenthesis_must_be_preceded_by_picture_symbol + | Unexpected_char of char + | Extraneous_symbol_in_exponent + | Symbol_may_only_appear_once of symbol + | Symbol_must_be_at_start of symbol + | Symbol_must_be_at_end of symbol + | Symbol_must_be_at_start_or_end of symbol + | Symbols_are_mutually_exclusive of symbol * symbol + | Unexpected_symbol of symbol * category option + | Empty_picture_string + | Picture_length_exceeds_limit of (* length *) int * (* max_len *) int + | Missing_symbol_in_exponent + | Missing_digits_in_exponent + | Picture_describes_empty_data_item + | Numeric_item_cannot_exceed_38_digits of int + + + (* Nicolas' style interface :-) *) + module type ENV = sig + val decimal_char: char + val currency_signs: Cobol_common.Basics.CharSet.t + end + +end + +type t = TYPES.picture +[@@deriving show] + +open TYPES + +(** [is_edited c] indicates whether the given category represents an edited + item *) +val is_edited: category -> bool + +(** data size (in "characters" --- probably with implemententor specific + semantics) *) +val data_size: category -> int + +(** display size, after editions; corresponds to "size" in standards *) +val size: category -> int + +val of_string: picture_config -> string -> + ( TYPES.picture, + ( TYPES.error * (int*int)) (* = (error, (pos,len)) *) + list + * TYPES.picture + ) result + +module Make (Config: Cobol_config.T) (Env: ENV) : sig + + exception InvalidPicture of + string with_loc * Cobol_common.Diagnostics.diagnostics * picture + + val of_string: string with_loc -> t with_loc +end + +val pp_meaning_of_precedence_index : + TYPES.picture_config -> Format.formatter -> int -> unit + +(** Verifies that the picture string is interpreted as `expect`, + i.e. the result of `pp_picture`. If not, displays the difference on + stderr and returns `false` *) +val unit_test : + ?config:TYPES.picture_config -> expect:string -> string -> bool diff --git a/src/lsp/cobol_data/pictured_ast.ml b/src/lsp/cobol_data/pictured_ast.ml new file mode 100644 index 000000000..087f48010 --- /dev/null +++ b/src/lsp/cobol_data/pictured_ast.ml @@ -0,0 +1,44 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* NB: not sure we need the full pictured AST. We may only need (part of) + Data_sections/division. *) + +open Cobol_ast + +module CharSet = Cobol_common.Basics.CharSet + +module Misc_sections = + Cobol_ast.Raw.Misc_sections +module Picture = struct + type picture = Picture.t with_loc [@@deriving show] +end +module Data_sections = + Cobol_ast.Raw.Data_sections (Picture) +module Data_division = + Cobol_ast.Raw.Data_division (Data_sections) +module Statements = + Cobol_ast.Raw.Statements +module Proc_division = + Cobol_ast.Raw.Proc_division (Statements) +module Compilation_group = + Cobol_ast.Raw.Compilation_group + (Misc_sections) (Data_division) (Proc_division) + +include Compilation_group +include Proc_division +include Statements +include Data_division +include Data_sections +include Picture +include Misc_sections diff --git a/src/lsp/cobol_data/qualmap.ml b/src/lsp/cobol_data/qualmap.ml new file mode 100644 index 000000000..b94adc5dd --- /dev/null +++ b/src/lsp/cobol_data/qualmap.ml @@ -0,0 +1,204 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_ast +open Cobol_common.Srcloc.INFIX + +module QUAL_NAME = struct + type t = qualname [@@deriving show] + + let compare = Cobol_ast.compare_qualname + +end + +module QualNameMap = struct + include Map.Make(QUAL_NAME) + let pp ?(sep=(fun fmt -> Fmt.pf fmt "@;")) pp_elt fmt m = + iter + (fun key elt -> + Fmt.pf fmt "%a: %a%t" pp_qualname key pp_elt elt sep) + m +end + +module QualNameSet = struct + include Set.Make(QUAL_NAME) + let pp ?(sep=(fun fmt -> Fmt.pf fmt "@ ")) fmt s = + iter + (fun elt -> + Fmt.pf fmt "%a%t" pp_qualname elt sep) + s +end + +module NameSet = struct + include Set.Make(struct + open Cobol_common.Srcloc.TYPES + type t = name with_loc + let compare {payload = p1; _} {payload = p2; _} = + compare p1 p2 + end) + let pp ppf s = Fmt.(braces (seq pp_name')) ppf (to_seq s) [@@warning "-32"] (*unused, for debug mainly*) +end + +type 'a binding = { + value: 'a; + full_key: QUAL_NAME.t; + simple_name: name; + contained_in: name with_loc list; (*Invariant: The first element is the 01 name, with the following + ones in increasing level numbers *) +} [@@deriving show] + +type 'a t = { + base_keys: QualNameSet.t; + bindings: 'a binding QualNameMap.t; +} [@@deriving show] + +let empty = { base_keys = QualNameSet.empty; + bindings = QualNameMap.empty; } + +(** [take_after pred list] returns the list with all the elements that are after + the first element that verifies [pred element] or the empty list if no + element verifies [pred]. *) +let rec take_after pred = function + | hd::tl when pred hd -> tl + | _::tl -> take_after pred tl + | [] -> [] + +(** [get_lower_key qualname] returns {!qualname} without the last [Name _] in + it, or [Name name] when qualname is [Qual (name, Name _) | Name name] *) +let rec get_lower_key qualname = + match qualname with + | Qual (n, Name _) -> + (Name n: qualname) + | Qual (n, qn) -> + let rest = get_lower_key qn in + Qual (n, rest) + | _ -> qualname + +(** [find_with_subkey key map] returns the map with all the qualnames that can be accessed + with the key [key]. *) +let rec find_with_subkey key map = + match key with + | Qual (_, Qual _) -> + (*we first look for all the items that are contained in the last qualifier. *) + let highest_level_name = Cobol_ast.major_qualifier_of_qualname key in + let new_map = + QualNameMap.filter_map + (fun _ ({contained_in; _} as binding) -> + let rest = + take_after (fun {payload; _} -> + payload = ~&highest_level_name) contained_in + in + if rest <> [] then + Some ({binding with contained_in = rest}) + else + None) + map + in + (* We keep looking for an item without the last qualifier *) + find_with_subkey (get_lower_key key) new_map + | Qual (_, Name n ) -> + let new_map = + QualNameMap.filter + (fun _ {contained_in; _ } -> + List.exists (fun {payload; _} -> payload = ~&n) contained_in) + map + in + (* We keep looking for an item without the last qualifier *) + find_with_subkey (get_lower_key key) new_map + | Name name -> + QualNameMap.filter + (fun _ ({simple_name; _}) -> simple_name = ~&name) + map + +let find_binding key map = + if QualNameSet.mem key map.base_keys then + (QualNameMap.find key map.bindings) + else + let simple_name' = Cobol_ast.qualifier_of_qualname key in + (* We look for all the qualnames that have the simple name `simple_name'`. *) + let new_map = + QualNameMap.filter (fun _ {simple_name; _} -> simple_name = ~&simple_name') map.bindings + in + (* If we find several then we look for names with the subkey `key`. *) + let new_map = find_with_subkey key new_map in + if QualNameMap.cardinal new_map = 1 then + (snd @@ QualNameMap.choose new_map) + else + raise Not_found + +(** [find qualname map] returns the unique element [e] of [map] that can be qualified with + [qualname]. Raises [Not_found] if the element is not unique, or does not exists in [map]. *) +let find key map = + (find_binding key map).value + +(** [find_opt qualname map] returns [Some elt] if [elt] is the unique element of [map] that + can be qualified by [qualname]. It returns [None] if there is no element or the uniqueness + is not respected. *) +let find_opt key map = + try Some (find key map) + with Not_found -> None + +(** [find_all qualname map] returns all the elements that can be qualified with [qualname] in [map]. *) +let find_all key map = + let simple_name' = Cobol_ast.qualifier_of_qualname key in + let new_map = + QualNameMap.filter (fun _ {simple_name; _} -> simple_name = ~&simple_name') map.bindings + |> find_with_subkey key + in + let binding_list = List.of_seq @@ QualNameMap.to_seq new_map in + List.map (fun (_, elt) -> (elt.full_key, elt.value)) binding_list + +(** [find_full_qualname qualname map] returns the full name of [qualname] if it is unique *) +let find_full_qualname key map = + (find_binding key map).full_key + +(** [find_full_qualname_opt qualname map] returns [Some full_name] with [full_name] being the + fully qualified name of [qualname] if it exists, [None] otherwise*) +let find_full_qualname_opt key map = + try Some ((find_binding key map).full_key) + with _ -> None + +let make_contained_in key = + let rec aux acc key = + match key with + | Qual (name, qn) -> + aux (name::acc) qn + | Name name -> + name::acc + in + match (key: qualname) with + | Qual (_, qn) -> aux [] qn + | Name _ -> [] + +(** [add qualname value map] returns [map] with [value] bound to the key [qualname]. [qualname] is + assumed to be the fully qualified name of [value].*) +let add key elt map = + let binding = + { value = elt; + full_key = key; + simple_name = ~&(Cobol_ast.qualifier_of_qualname key); + contained_in = make_contained_in key; } + in + { base_keys = QualNameSet.add key map.base_keys; + bindings = QualNameMap.add key binding map.bindings; } + +(** [iter f map] iters over all the values of [map], note that the first argument of [f] is the fully + qualified name of the element. *) +let iter f map = + QualNameMap.iter (fun key {value; _} -> f key value) map.bindings + +(** [fold f map init] folds over all the key values bindings of [map], note that the first argument + of [f] is fully qualified name of the element. *) +let fold f map init = + QualNameMap.fold (fun key {value; _} acc -> f key value acc) map.bindings init + diff --git a/src/lsp/cobol_data/qualmap.mli b/src/lsp/cobol_data/qualmap.mli new file mode 100644 index 000000000..54037111e --- /dev/null +++ b/src/lsp/cobol_data/qualmap.mli @@ -0,0 +1,48 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_ast + +type 'a t [@@deriving show] + +val empty: 'a t + +(** [find qualname map] returns the unique element [e] of [map] that can be qualified with + [qualname]. Raises [Not_found] if the element is not unique, or does not exists in [map]. *) +val find: qualname -> 'a t -> 'a + +(** [find_opt qualname map] returns [Some elt] if [elt] is the unique element of [map] that + can be qualified by [qualname]. It returns [None] if there is no element or the uniqueness + is not respected. *) +val find_opt: qualname -> 'a t -> 'a option + +(** [find_all qualname map] returns all the elements that can be qualified with [qualname] in [map] + with their fully qualified name. *) +val find_all: qualname -> 'a t -> (qualname * 'a) list + +(** [find_full_qualname qualname map] returns the full name of [qualname] if it is unique *) +val find_full_qualname: qualname -> 'a t -> qualname + +(** [find_full_qualname_opt qualname map] returns [Some full_name] with [full_name] being the + fully qualified name of [qualname] if it exists, [None] otherwise*) +val find_full_qualname_opt: qualname -> 'a t -> qualname option + +(** [add qualname value map] returns [map] with [value] bound to the key [qualname]. [qualname] is + assumed to be the fully qualified name of [value].*) +val add: qualname -> 'a -> 'a t -> 'a t + +(** [iter f map] iters over all the values of [map]. *) +val iter: (qualname -> 'a -> unit) -> 'a t -> unit + +(** [fold f map init] folds over all the key values bindings of [map] *) +val fold: (qualname -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b diff --git a/src/lsp/cobol_data/types.ml b/src/lsp/cobol_data/types.ml new file mode 100644 index 000000000..1389241cf --- /dev/null +++ b/src/lsp/cobol_data/types.ml @@ -0,0 +1,106 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* open Cobol_common.Srcloc.TYPES *) +(* open Cobol_common.Srcloc.INFIX *) +(* open Cobol_ast *) + +(* TODO: those properties should be re-introduced later when relevant; they are + commented for now as they do not appear necessary to the classicfication of + data items. *) + +(* type bit_length = *) +(* | L16 *) +(* | L32 *) +(* | L62 [@@deriving show] *) + +(* type pointer_length = *) +(* | L4 *) +(* | L8 [@@deriving show] *) + +(* type numeric_format = { *) +(* signed: bool; *) +(* integer_length: int; *) +(* decimal_length: int; *) +(* } [@@deriving show] *) + +(* type numeric_encoding = *) +(* | Ascii *) +(* | Bcd *) +(* | Int of bit_length *) +(* | Float of bit_length [@@deriving show] *) + +(* (\* NOTE: The numeric does not support yet the floating point format of the 2014 standard *\) *) +(* type numeric = *) +(* (numeric_format * numeric_encoding) [@@deriving show] *) + +(* type alphanumeric_category = *) +(* | Alphanumeric of int *) +(* | AlphanumericEdited of int [@@deriving show] *) + +(* type national_category = (\* UTF-16 *\) *) +(* | National of int *) +(* | NationalEdited of int [@@deriving show] *) + +type elementary_data_class = + | Alphabetic + | Alphanumeric + | Boolean + | Index + | National + | Numeric + | Object + | Pointer +[@@deriving show] + +(* (\* TODO: Remove name from types *\) *) + +type data_type = + | Elementary of elementary_data_class leveled pictured + | Table of table_type leveled + | Group of data_type Cobol_ast.with_loc list leveled +[@@deriving show] + +and 'a leveled = { + typ: 'a; + level: int; +} [@@deriving show] + +and 'a pictured = 'a * Picture.t option [@@deriving show] + +and table_type = { + elements_type: data_type Cobol_ast.with_loc; + length: table_length; +} + +and table_length = + | Fixed of Cobol_ast.integer + | OccursDepending of (* TODO: get rid of that (duplicate of AST nodes) *) + { (* TODO: resolve depending before building the final type repr. *) + min_size: Cobol_ast.integer; + max_size: Cobol_ast.integer; + depending: Cobol_ast.qualname Cobol_ast.with_loc; + } [@@deriving show] + +(* let loc_of = function *) +(* | Elementary typ_loc -> ~@typ_loc *) +(* | Group fields_loc -> ~@fields_loc *) +(* | Table elements_loc -> ~@elements_loc *) + +(* let level_of = function *) +(* | Elementary { payload = {level; _}, _; _ } *) +(* | Group { payload = {level; _}; _ } *) +(* | Table { payload = {level; _}; _ } -> level *) + +(* let pp_cob_data_type_loc fmt data_type = *) +(* pp_cob_data_type fmt data_type *) diff --git a/src/lsp/cobol_data/typing.ml b/src/lsp/cobol_data/typing.ml new file mode 100644 index 000000000..ea32e7089 --- /dev/null +++ b/src/lsp/cobol_data/typing.ml @@ -0,0 +1,294 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.INFIX +open Pictured_ast.Data_sections +open Types +open Cobol_ast + +let cobol_class_of_picture: Picture.t -> Types.elementary_data_class = fun pic -> + match pic.category with + | Alphabetic _ -> Alphabetic + | Alphanumeric _ -> Alphanumeric + | Boolean _ -> Boolean + | National _ -> National + | FixedNum _ | FloatNum _ -> Numeric + +let rec of_data_group + ((module Diags: Cobol_common.Diagnostics.STATEFUL) as diags) + program_environment data_group = + match ~&data_group with + | Group.Elementary {data_item = Data dde; name = _} -> + let level = ~&(dde.data_level) and loc = ~@data_group in + let picture, usage, occurs = + List.fold_left begin fun (pic, usage, occurs) { payload = clause; _ } -> + match clause with + | DataPicture { payload = { picture = pic; _ }; _ } -> + Some pic, usage, occurs + | DataUsage usage_clause -> + pic, Some usage_clause, occurs + | DataOccurs occurs_clause -> + pic, usage, Some occurs_clause + | _ -> + pic, usage, occurs + end (None, None, None) dde.data_clauses + in + let element = + match picture, usage with + | Some pic, None -> + Ok (Elementary ({ typ = cobol_class_of_picture ~&pic; level }, + Some ~&pic) &@ loc) + | None, Some usage -> + begin match usage with + | Index -> + Ok (Elementary ({typ = Index; level}, None) &@ loc) + | Pointer _ + | FunctionPointer _ + | ProgramPointer _ -> + Ok (Elementary ({typ = Pointer; level}, None) &@ loc) + (* | ProgramPointer _ -> *) + (* Result.ok @@ Elementary (({typ = Types.Pointer (\* L8 *\); level}, None) &@ loc) *) + | ObjectReference _ -> + Ok (Elementary ({typ = Types.Object; level}, None) &@ loc) + | _ -> + Diags.error ~loc "Missing@ PICTURE@ clause"; + Result.Error () + end + | Some picture, Some usage -> + let cobol_class = cobol_class_of_picture ~&picture in + begin match usage, cobol_class with + | (Binary | PackedDecimal), Numeric -> + Ok (Elementary ({ typ = cobol_class; level }, Some ~&picture) &@ loc) + | (Binary | PackedDecimal), _ -> + Diags.error ~loc + "The picture associated with a USAGE clause of type BINARY \ + (COMP) or PACKED-DECIMAL must be a numeric picture"; + Error () + | _ -> + Ok (Elementary ({typ = cobol_class; level}, Some ~&picture) &@ loc) + end + | None, None -> + Diags.error ~loc "Missing@ USAGE@ or@ PICTURE@ clause@ for@ \ + elementary@ item"; + Error () + in + Result.bind + element + (fun element -> match occurs with + | Some occurs_clause -> + begin match occurs_clause with + | OccursFixed occurs_fixed -> + Ok (Table { typ = { elements_type = element; + length = Fixed occurs_fixed.times }; + level } &@ loc) + | OccursDepending { from; to_; depending; _ } -> + let length = Types.OccursDepending { min_size = from; + max_size = to_; + depending } in + Ok (Table { typ = { elements_type = element; length }; level } &@ loc) + | OccursDynamic _ -> + Diags.warn ~loc "Table with dynamic capacity are not implemented yet."; + Result.Error () + end + | None -> Result.Ok element) + | Group {elements = dgl; data_item = Data dde; name = _} -> + let level = ~&(dde.data_level) and loc = ~@data_group in + let elements = + (* If a group has usage clause then it is applied to every elementary + item of this group. *) + try + let usage = + List.find (function { payload = DataUsage _; _ } -> true | _ -> false) + dde.data_clauses + in + let rec prepend_usage usage ({ payload; loc } as dg) = + match payload with + | Group.Elementary ({data_item = Data ({ data_clauses; + _} as data_item); + _ } as element) -> + let data_item = Data { data_item with + data_clauses = usage :: data_clauses } in + Group.Elementary { element with data_item } &@ loc + | Group ({ elements; _ } as group) -> + let elements = List.map (prepend_usage usage) elements in + Group.Group { group with elements } &@ loc + | _ -> + dg + in + List.map (prepend_usage usage) dgl + with Not_found -> dgl + in + let elements = + List.map + (fun dg -> of_data_group diags program_environment dg) + elements + |> Cobol_common.join_all + in + let occurs = + List.find_opt begin fun ddc -> match ~&ddc with + | DataOccurs _ -> true + | _ -> false + end dde.data_clauses + in + Result.map + (fun elements -> + match occurs with + | Some { payload = DataOccurs occurs_clause; _ } -> + let group = Group { typ = elements; level } &@ loc in + begin + match occurs_clause with + | OccursFixed occurs_fixed -> + Types.Table { typ = { elements_type = group; + length = Fixed occurs_fixed.times }; + level } &@ loc + | OccursDepending { from; to_; depending; _ } -> + let length = + Types.OccursDepending { min_size = from; + max_size = to_; + depending } + in + Table { typ = { elements_type = group; length }; level } &@ loc + | _ -> failwith "Not implemented yet" + end + | Some _ -> failwith "Unreachable" + | None -> Group { typ = elements; level } &@ loc) + elements + | Renames { targets; _ } -> + (* RENAMES rules: first and last must not be occurs or subordinate to occurs, but can + have occurs subordinate to them. These subordinate occurs must be of + fixed length. *) + let loc = ~@data_group in + let has_occurs = function + | { payload = DataOccurs _; _ } -> true + | _ -> false + and has_complex_occurs = function + | { payload = DataOccurs (OccursDepending _ | + OccursDynamic _); _ } -> true + | _ -> false + in + let rec check_data_group is_first_or_last (data_group: Group.t) = + match ~&data_group with + | Renames _ | Constant _ -> true + | ConditionName _ -> + Diags.error ~loc "RENAMES@ may@ not@ reference@ a@ level@ 88."; + false + | Elementary { data_item = Data data_item; _ } + | Group { data_item = Data data_item; _ } + when is_first_or_last && + List.exists has_occurs data_item.data_clauses -> + Diags.error ~loc "Forbidden@ RENAMES@ of@ data@ item@ with@ \ + OCCURS@ clause."; + false + | Elementary _ + | Group _ + when is_first_or_last -> + true + | Elementary { data_item = Data data_item; _ } + when List.exists has_complex_occurs data_item.data_clauses -> + Diags.error ~loc "RENAMES@ cannot@ reference@ a@ data@ item@ with@ \ + OCCURS@ DEPENDING@ or@ OCCURS@ DYNAMIC@ clause"; + false + | Elementary _ -> + true + | Group { data_item = Data data_item; _ } + when List.exists has_complex_occurs data_item.data_clauses -> + Diags.error ~loc "RENAMES@ cannot@ reference@ a@ data@ item@ with@ \ + OCCURS@ DEPENDING@ or@ OCCURS@ DYNAMIC@ clause"; + false + | Group { elements; _ } -> + List.for_all (check_data_group false) elements + in + begin match targets with + | hd::[] -> + if check_data_group true hd then + of_data_group diags program_environment hd + else + Error () + | (hd::tl) -> + let tl_rev = List.rev tl in + let last = List.hd tl_rev in + let middle = List.rev @@ List.tl tl_rev in + if check_data_group true hd && check_data_group true last + && List.for_all (check_data_group false) middle + then + let elements = + List.map (of_data_group diags program_environment) targets + |> Cobol_common.join_all + in + Result.map (fun elements -> Group {typ = elements; level = 66} &@ loc) elements + else + Error () + | [] -> + Diags.error ~loc "The@ RENAMES@ clause@ cannot@ be@ typed@ (empty@ group@ types)"; + Error () + end + | Constant _ -> + Diags.error "Not implemented yet: Type of constant."; + Result.Error () + | ConditionName {name = _; _} -> + (* Condition-names are not elementary data items. Instead, they are + subordicate to a group. *) + (* Ok (Elementary (({typ = Conditional; level = 88L }, None) &@<- data_group)) *) + Diags.error "Not implemented yet: Type of condition name"; + Result.Error () + +(*TODO: * Check if first or last item has an occurs clauses. + * Take into account subordinates occurs clauses: Idea: + - In the environment make a fixed lenght table have the same number of sub items as + the number of occurs, i.e 10 TAB PIC XX OCCURS 3 TIMES would have the sub items + TAB1, TAB2, TAB3 of type Alphanumeric 2. +*) +(* let of_rename_entry (prog_env: Cobol_env.PROG_ENV.t) dde_before rename_entry = + let renamed_qualname = QualMap.find_full_qualname ~&rename_entry.renamed_item prog_env.data_items in + match ~&rename_entry.through_opt with + | None -> + let renamed_data_item = QualMap.find renamed_qualname prog_env.data_items in + let data_item_type = match renamed_data_item.typ with + | None -> failwith "Please type the classic data items before typing the renames entry." + | Some (typ) -> typ + in + data_item_type + | Some(through_item) -> + let through_qualname = QualMap.find_full_qualname through_item prog_env.data_items in + let paths = Cobol_data_group.range_of_data_groups renamed_qualname through_qualname [dde_before] in + let renamed_elements = List.fold_left (fun acc (occurs, path) -> + let data_item_qualname = Group.of_list path in + let data_item = QualMap.find data_item_qualname prog_env.data_items in + let data_name = data_item.name in + let data_type = match data_item.typ with + | None -> failwith "The items must be typed" + | Some typ -> typ + in + let rec add_occurs acc n data_name data_type = + match n with + | 1 -> List.rev acc + | _ -> + let new_name = Format.sprintf "__%s_%d" data_name (n - 2) in + add_occurs ({field_name = new_name; field_type = data_type}::acc) (n-1) data_name data_type + in + let new_list = + add_occurs + [{field_name = ~&data_name; field_type = data_type}] + occurs + ~&data_name + data_type + in + acc@new_list + ) [] paths + in + let typ = + Cobol_types.Group ({ typ = renamed_elements; level = 66L } &@<- + rename_entry) in + let name = ~&rename_entry.data_name in + print_endline ([%derive.show: (string * cob_data_type)] (~&name, typ)); + typ *) diff --git a/src/superbol-vscode-platform/version.mlt b/src/lsp/cobol_data/version.mlt similarity index 100% rename from src/superbol-vscode-platform/version.mlt rename to src/lsp/cobol_data/version.mlt diff --git a/src/lsp/cobol_indent/TODO.md b/src/lsp/cobol_indent/TODO.md new file mode 100644 index 000000000..c5fcdafdc --- /dev/null +++ b/src/lsp/cobol_indent/TODO.md @@ -0,0 +1,15 @@ +TODO: + - Implement continued literal over multiple lines + - Bug of tokenizer. Words joined by a "." are not well identified. e.x. According to the lexer, "PROGRAM-ID. HELLO" are 3 TextWords, but "PROGRAM-ID.HELLO." is a single TextWord (which causes error of indenter). (Both are legal in GnuCOBOL) + - Not satisfied with the `Cobol_preproc.fold_text_lines`, this function has an argument which is the name of file, so when using lsp, every time using the formatting, we must save the file first, it is not convenient. + - Use a new type (other than `context_kind`) to represent the `scope` + - Rewrite the `indent_config` (like ocp-indent, we may let the client to decide if it activates some features like alignment of argument) + - PERFORM statement has two formats, inline or out-of-line. Not easy to distinguish these two formats without parsing. Now, we regard only "PERFORM {word} TIMES ..." "PERFORM WITH ..." "PERFORM TEST ..." "PERFORM UNTIL ..." "PERFORM VARYING ..." as inline format. + There is a bug, since the `ident` of `"PERFORM ident TIMES ..."` can contain more than 1 word like "PERFORM X (3) TIMES ...". + - Maybe do the preprocessing to link some successive keywords. ex. "ON" "SIZE" "ERROR" -> "ON_SIZE_ERROR" (the code will be more brief if we do this) + - Only support standard ISO/IEC 1989:2014 + - Careful check for method/interface/factory/function.... I have not verified if there is difference (of indentation) between these compilation unit. + - Add check of clause in ENV DIVISION if need be + - Refine the check of phrase/clause of PROCEDURE/DATA DIVISION + - Find a better way to solve the keyword conflict "(ON)EXCEPTION" + - The NEXT SENTENCE phrase inside IF/SEARCH statement, it seems that the GnuCOBOL implements it differently than described in the standard of COBOL, however, I am not sure since I cannot test it in mainframe.(In GnuCOBOL, it allows `IF (conditon) [THEN] NEXT SENTENCE {nested-statement}.` But according to the standard, the THEN branche must be `NEXT SENTENCE` or `nested-statement` but cannot contain both) diff --git a/src/lsp/cobol_indent/cobol_indent.ml b/src/lsp/cobol_indent/cobol_indent.ml new file mode 100644 index 000000000..449ab69cb --- /dev/null +++ b/src/lsp/cobol_indent/cobol_indent.ml @@ -0,0 +1,30 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* If you delete or rename this file, you should add + 'src/cobol_indent/main.ml' to the 'skip' field in "drom.toml" *) + +module Type = Indent_type + +(*return the result of indentation. use user-defined indent_config*) +let indent_range' = Indenter.indent_range' + +(*indent the whole file and print*) +let indent_file ~source_format ~file ~indent_config = + indent_range' ~source_format ~range:None ~indent_config ~file + |> Fmt.pr "%s" + +(*indent a range of file and print*) +let indent_range ~source_format ~file ~range ~indent_config = + indent_range' ~source_format ~range ~indent_config ~file + |> Fmt.pr "%s" diff --git a/src/lsp/cobol_indent/dune b/src/lsp/cobol_indent/dune new file mode 100644 index 000000000..6ba8996d0 --- /dev/null +++ b/src/lsp/cobol_indent/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_indent) + (public_name cobol_indent) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries fmt cobol_preproc cobol_common ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_indent)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_indent/indent_check.ml b/src/lsp/cobol_indent/indent_check.ml new file mode 100644 index 000000000..b16877590 --- /dev/null +++ b/src/lsp/cobol_indent/indent_check.ml @@ -0,0 +1,1218 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc +open Cobol_common.Basics + +open Indent_type +open Indent_keywords +open Indent_util + +(* + Remark: + In general, `check_{scope-name}` handles the tokens of that scope, + and will call a child "check function" to check its child scope in some cases, + and go back to its parent "check function" when this scope is terminated. + + ex. + `check_data_div` will call `check_RD` if it encounters a token "RD". + When the RD is terminated by a ".", it will call the `check_data_div`. + i.e. + When `check_data_div` is called, and if encounter "RD", + the `check_data_div` handle this token, update the arguments + and call `check_RD`. + When inside RD, encounter a ".", handle this ".", update the + arguments and go back to `check_data_div`. + + In general, the `check_{scope-name}` does not treat the token which opens the scope itself. + However, for the reason of brevity (and scope inference for incomplete code), + the `check_ident_div` handles the token `IDENT_DIV` itself + ... `check_env_div` ................. `ENV_DIV` ...... + ... `check_data_div` ................. `DATA_DIV` ...... + ... `check_proc_div_header` ........... `PROC_DIV` ...... + ... `check_copy_replace` .............. `COPY/REPLACE` ... + +*) + +type text = Cobol_preproc.Text.t + +let rec check_ident_div (text:text) (state:indent_state) (ifcheck:bool) = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload = TextWord "IDENTIFICATION"; loc} :: {payload = TextWord "DIVISION"; _} + :: {payload = TextWord "."; _} :: wordlist -> + let context = pop_until_division context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context COMPILATION_UNIT context in + let context = push_context IDENT_DIV context in + check_ident_div wordlist {state with context; acc} false + + (*TODO:Careful check for method/interface/factory/function.... + if any difference (of indentation) between these compilation unit *) + | {payload = TextWord ("PROGRAM-ID"|"CLASS-ID"|"FACTORY"|"FUCNTION-ID" + |"INTERFACE-ID"|"METHOD-ID"|"OBJECT"); loc} + :: {payload = TextWord "."; _} :: wordlist -> + let context = pop_until_division context in + begin match context with + | (IDENT_DIV, _) :: (COMPILATION_UNIT, offset) :: _ -> + let acc = check_pos loc offset acc ifcheck in + check_ident_div wordlist {state with context; acc} false + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context COMPILATION_UNIT context in + let context = push_context IDENT_DIV context in + check_ident_div wordlist {state with context; acc} false + end + + | {payload = TextWord "OPTIONS"; loc} + :: {payload = TextWord "."; _} :: wordlist -> + let context = pop_until COMPILATION_UNIT context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context PARAGRAPH context in + check_ident_div wordlist {state with context; acc} false + + (*jump to ENVIRONMENT DIVISION*) + | {payload = TextWord "ENVIRONMENT"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_env_div text {state with scope = ENV_DIV} ifcheck + (*jump to DATA DIVISION*) + | {payload = TextWord "DATA"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_data_div text {state with scope = DATA_DIV} ifcheck + (*jump to PROCEDURE DIVISION*) + | {payload = TextWord "PROCEDURE"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_proc_div_header text {state with scope = PROC_DIV_HEADER} ifcheck + + (*end compilation_unit*) + | {payload = TextWord "END"; loc } + :: {payload = TextWord ("PROGRAM"|"CLASS"|"FACTORY"|"FUNCTION" + |"OBJECT"|"METHOD"|"INTERFACE"); _} :: wordlist -> + end_compilation_unit loc wordlist state ifcheck + + | {payload;loc} :: wordlist as _text -> + begin match payload with + | CDirWord _ -> + check_ident_div wordlist state false + | TextWord "." -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_ident_div wordlist {state with context; acc} false + | TextWord ("COPY"|"REPLACE") -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_ident_div wordlist {state with context; acc} false + end + + +(*************ENVIRONMENT DIVISION****************) +(*TODO:Add check of clause in ENV DIVISION if need be*) +and check_env_div (text:text) (state:indent_state) (ifcheck:bool) = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload = TextWord "ENVIRONMENT"; loc} :: {payload = TextWord "DIVISION"; _} :: wordlist -> + let context = pop_until_compilation_unit context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context ENV_DIV context in + check_env_div wordlist {state with context; acc} false + | {payload = TextWord _; loc} :: {payload = TextWord "SECTION"; _} + :: {payload = TextWord "."; _} :: wordlist -> + let context = pop_until SECTION context in + let context = + match context with + | (SECTION, _) :: context + | context -> context + in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context SECTION context in + check_env_div wordlist {state with context; acc} false + | {payload = TextWord ("SOURCE-COMPUTER"|"OBJECT-COMPUTER"|"SPECIAL-NAMES"|"REPOSITORY" + |"FILE-CONTROL"|"I-O-CONTROL"); loc} + :: {payload = TextWord "."; _} :: wordlist -> + let context = pop_until SECTION context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context PARAGRAPH context in + check_env_div wordlist {state with context; acc} false + (*jump to other division*) + | {payload = TextWord "IDENTIFICATION"; _} :: {payload = TextWord "DIVISION"; _} :: _ + | {payload = TextWord ("PROGRAM-ID"|"CLASS-ID"|"FACTORY"|"FUCNTION-ID" + |"INTERFACE-ID"|"METHOD-ID"|"OBJECT"); _} + :: {payload = TextWord "."; _} :: _ -> + check_ident_div text {state with scope = IDENT_DIV} ifcheck + | {payload = TextWord "DATA"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_data_div text {state with scope = DATA_DIV} ifcheck + | {payload = TextWord "PROCEDURE"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_proc_div_header text {state with scope = PROC_DIV_HEADER} ifcheck + + (*end compilation_unit*) + | {payload = TextWord "END"; loc } + :: {payload = TextWord ("PROGRAM"|"CLASS"|"FACTORY"|"FUNCTION" + |"OBJECT"|"METHOD"|"INTERFACE"); _} :: wordlist -> + end_compilation_unit loc wordlist state ifcheck + + | {payload; loc} :: wordlist as _text-> + begin + match payload with + | CDirWord _ -> + check_env_div wordlist state false + | TextWord ("COPY"|"REPLACE") -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | TextWord "SELECT" -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context SELECT context in + check_env_div wordlist {state with context; acc} false + | TextWord "." -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_env_div wordlist {state with context; acc} false + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_env_div wordlist {state with context; acc} false + end + +(*************DATA DIVISION****************) +(*TODO: Refine the check of clause of DATA DIVISION*) +and check_data_div (text:text) (state:indent_state) ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload = TextWord "DATA"; loc } :: {payload = TextWord "DIVISION"; _} + :: wordlist -> + let context = pop_until_compilation_unit context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context DATA_DIV context in + check_data_div wordlist {state with context; acc} false + | {payload = TextWord _; loc} :: {payload = TextWord "SECTION"; _} :: wordlist -> + let context = pop_until SECTION context in + let context = + match context with + | (SECTION, _) :: context + | context -> context + in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context SECTION context in + check_data_div wordlist {state with context; acc} false + | {payload = TextWord "IDENTIFICATION"; _} :: {payload = TextWord "DIVISION"; _} :: _ + | {payload = TextWord ("PROGRAM-ID"|"CLASS-ID"|"FACTORY"|"FUCNTION-ID" + |"INTERFACE-ID"|"METHOD-ID"|"OBJECT"); _} + :: {payload = TextWord "."; _} :: _ -> + check_ident_div text {state with scope = IDENT_DIV} ifcheck + | {payload = TextWord "ENVIRONMENT"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_proc_div text {state with scope = ENV_DIV} ifcheck + | {payload = TextWord "PROCEDURE"; _} :: {payload = TextWord "DIVISION"; _} :: _ -> + check_proc_div_header text {state with scope = PROC_DIV_HEADER} ifcheck + (*end compilation_unit*) + | {payload = TextWord "END"; loc } + :: {payload = TextWord ("PROGRAM"|"CLASS"|"FACTORY"|"FUNCTION" + |"OBJECT"|"METHOD"|"INTERFACE"); _} :: wordlist -> + end_compilation_unit loc wordlist state ifcheck + + | {payload; loc} :: wordlist as _text -> + match payload with + | CDirWord _ -> + check_data_div wordlist state false + | TextWord word -> + begin match data_context_of_str word with + | Compiler_directive _ -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | Entry (FD|RD|SD as key) -> + let context = pop_until SECTION context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context key context in + check_fun key wordlist {state with scope = key; context; acc} false + (*Data declaration*) + (*77-level data description entry*) + | Entry (LEVEL 77) -> + let context = pop_until SECTION context in + let context = push_context DATA_DESC context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_desc wordlist {state with scope = DATA_DESC; context; acc} false + (*rename clause*) + | Entry (LEVEL 66) -> + let context = pop_until (LEVEL 1) context in + let context = push_context DATA_DESC context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_desc wordlist {state with scope = DATA_DESC; context; acc} false + | Entry (LEVEL level as key) -> + let context = reduce_level level context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context key context in + let context = push_context DATA_DESC context in + check_data_desc wordlist {state with scope = DATA_DESC; context; acc} false + | PERIOD -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_div wordlist {state with context; acc} false + | No_keyword -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_div wordlist {state with context; acc} false + | _ -> failwith @@ failure_msg loc + end + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_div wordlist {state with context; acc} false + +and check_data_div_entry clauses key (text:text) state ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist as _text -> + match payload with + | CDirWord _ -> + check_data_div_entry clauses key wordlist state ifcheck + | TextWord ("COPY"|"REPLACE") -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | TextWord str when StringSet.mem str clauses -> + let context = pop_until key context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context DATA_DIV_CLAUSE context in + check_data_div_entry clauses key wordlist {state with context; acc} false + | TextWord "." -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_div wordlist {state with scope = DATA_DIV; context; acc} false + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_data_div_entry clauses key wordlist {state with acc} false + +and check_FD text state ifcheck = check_data_div_entry + (StringSet.of_list ["EXTERNAL"; "GLOBAL"; "FORMAT"; "BLOCK"; "CODE-SET"; "RECORD"; "LINAGE"]) + FD text state ifcheck + +and check_RD text state ifcheck = check_data_div_entry + (StringSet.of_list ["GLOBAL"; "CODE"; "CONTROL"; "CONTROLS"; "PAGE"]) + RD text state ifcheck + +and check_SD text state ifcheck = + check_data_div_entry (StringSet.of_list ["RECORD"]) SD text state ifcheck + +(*TODO: if necessary, distinguish data description with screen description*) +and check_data_desc text state ifcheck = + check_data_div_entry + (StringSet.of_list + [(*keyword of data description entry*) + "REDEFINES"; "TYPEDES"; "ALIGNED"; "ANY"; "BASED"; "BLANK"; "CONSTANT"; "DYNAMIC"; + "EXTERNAL"; "GLOBAL"; "GROUP-USAGE"; "JUST"; "JUSTIFIED"; "OCCURS"; "PIC"; "PICTURE"; + "PROPERTY"; "SAME"; "SELECT"; "SIGN"; "LEADING"; "TAILING"; "SYNCHRONIZED"; "SYNC"; + "TYPE"; "CLASS"; "DEFAULT"; "DESTINATION"; "INVALID"; "PRESENT"; + "VARYING"; "VALIDATE-STATUS"; "VAL-STATUS"; "VALUE"; "VALUES"; + (*keyword of screen description entry*) + "LINE"; "COL"; "COLUMN"; "ERASE"; "FULL"; "AUTO"; "SECURE"; "REQUIRED"; "DISPLAY"; + "NATIONAL"; "BELL"; "BLINK"; "HIGHTLIGHT"; "LOWLIGHT"; "REVERSE-VIDEO"; "UNDERLINE"; + "FOREGROUND-COLOR"; "BACKGROUND-COLOR"; "USING" + (*TODO: The clauses FROM, TO are omitted here, since they can appear inside other clauses, + which makes the problem a little complex.*) + ]) + DATA_DESC text state ifcheck + + +(*************PROCEDURE DIVISION****************) +and check_proc_div_header (text:text) (state:indent_state) ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload = TextWord "PROCEDURE"; loc} :: {payload = TextWord "DIVISION"; _} :: wordlist + -> + let context = pop_until_compilation_unit context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context PROC_DIV context in + let context = push_context PROC_DIV_HEADER context in + check_proc_div_header wordlist {state with context; acc} false + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> + check_proc_div_header wordlist state ifcheck + | TextWord word -> + begin match proc_context_of_str word with + | Compiler_directive _ -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | No_keyword -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_proc_div_header wordlist {state with acc} false + | Phrase (USING|RAISING|BY as key) -> + handle_phrase key loc wordlist state ifcheck + | Inline_phrase -> + handle_inline_phrase loc wordlist state ifcheck + (*PERIOD here means the real beginning of the procedure divisoin*) + | PERIOD -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + (*for better indentation, we suppose that when procedure division begins, + there is an implicit paragraph just after the procedure division. *) + let context = push_context PARAGRAPH context in + check_proc_div wordlist {state with scope = PROC_DIV; context; acc} false + | _ -> + failwith @@ failure_msg loc + end + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_proc_div_header wordlist {state with context; acc} false + +and check_proc_div (text:text) (state:indent_state) ifcheck = + let context, acc = state.context, state.acc in + match text with + | {payload = TextWord "IDENTIFICATION"; _} :: {payload = TextWord "DIVISION"; _} + :: _ + | {payload = TextWord ("PROGRAM-ID"|"CLASS-ID"|"FACTORY"|"FUCNTION-ID" + |"INTERFACE-ID"|"METHOD-ID"|"OBJECT"); _} + :: {payload = TextWord "."; _} :: _ -> + check_ident_div text {state with scope = IDENT_DIV} ifcheck + + | {payload = TextWord "DECLARATIVES"; loc} :: {payload = TextWord "."; _} :: wordlist -> + let context = pop_until PROC_DIV context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context DECLARATIVES context in + let context = push_context PARAGRAPH context in + check_proc_div wordlist {state with context; acc} false + | {payload = TextWord "END"; loc} :: {payload = TextWord "DECLARATIVES"; _} + :: {payload = TextWord "."; _}:: wordlist -> + let context = pop_until DECLARATIVES context in + begin match context with + | (DECLARATIVES, _) :: context -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + (*for better indentation, we suppose that when procedure division begins, + there is an implicit paragraph just after the procedure division. *) + let context = push_context PARAGRAPH context in + check_proc_div wordlist {state with context; acc} false + | _ -> failwith @@ failure_msg loc end + + | {payload = TextWord name; loc} :: {payload = TextWord "SECTION"; _} + :: {payload = TextWord "."; _} :: wordlist when not @@ is_statement name -> + let context = + match context with + | (PARAGRAPH, _) :: (SECTION, _) :: context + | (PARAGRAPH, _) :: context + | context -> context + in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context SECTION context in + let context = push_context PARAGRAPH context in + check_proc_div wordlist {state with context; acc} false + | {payload = TextWord name; loc} :: {payload = TextWord "."; _} :: wordlist + when not @@ is_statement name -> + let context = + match context with + | (PARAGRAPH, _) :: context -> context + | _ -> context + in + let offset = offset_of_context context in + let acc = check_pos loc offset acc ifcheck in + let context = push_context PARAGRAPH context in + check_proc_div wordlist {state with context; acc} false + (*end compilation_unit*) + | {payload = TextWord "END"; loc } + :: {payload = TextWord ("PROGRAM"|"CLASS"|"FACTORY"|"FUNCTION" + |"OBJECT"|"METHOD"|"INTERFACE"); _} :: wordlist -> + end_compilation_unit loc wordlist state ifcheck + + (*TODO: find a better way to distinguish PERFORM(inline) and PERFORM_CLOSED(out-of-line)*) + (*A bug here, TODO.md for details*) + | {payload = TextWord "PERFORM"; loc } :: _ :: {payload = TextWord "TIMES"; _} :: wordlist + | {payload = TextWord "PERFORM"; loc } :: {payload = TextWord ("UNTIL"|"VARYING"|"WITH"|"TEST"); _} + :: wordlist -> + handle_open_scope PERFORM loc wordlist state ifcheck + + | {payload; loc} :: wordlist -> + begin match payload with + | CDirWord _ -> + check_proc_div wordlist state ifcheck + | TextWord word -> + begin match proc_context_of_str word with + | Compiler_directive _ -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | Open_scope keyword -> + handle_open_scope keyword loc wordlist state ifcheck + | _ -> + (* if all keywords of statements are implemented, this case never happens*) + (*failwith ("error proc_div: "^ word)*) + let offset = offset_of_context context in + let acc = check_pos loc offset acc ifcheck in + check_proc_div wordlist {state with acc} false + end + | _ -> + let offset = offset_of_context context in + let acc = check_pos loc offset acc ifcheck in + check_proc_div wordlist {state with acc} false + end + | [] -> state + + +(* General statement, handles "common tokens" which can follow any statement *) +(* Notice that we cannot know when a statement terminates in general*) +(* When the code is in a statement not explicitly terminated, + the next token can be + 1. keyword of other statement, "MOVE/ADD/DISPLAY..." + 2. "when" "else" "on size error" ... (it means the statement is nested) + 3. keyword inside the statement . ex. phrase/clause + 4. "END-xxx" + 5. PEROID *) +(* + `check_statement` should be regarded as an auxiliary function, + `check_statement` does not recursively call itself directly. + + At the begin, I define this function with the intention of reducing the duplicate code, + because inside any statement, there are a lot of "common token" to treat, + especially "NOT ON SIZE ERROR..." which are too long, hard to write. + TODO: maybe we had better do some preprocess, + ex. {TextWord "ON";loc} :: {TextWord "SIZE";_} :: {TextWord "ERROR";_} :: ... + -> {TextWord "ON_SIZE_ERROR";loc} :: ... + + The `check_statement` is called by other functions like `check_if_stmt`, + look at how `check_if_stmt` works: + If the current token is a statement-specific token (like `THEN`) + (or "common token" easy to write like `PERIOD`, `No_keyword`... ), + treat the current token and call recursively itself, + Otherwise + call `check_statement`. +*) +and check_statement (text:text) state ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + (*TODO: + Maybe do the preprocessing to link some successive keywords. + ex. "ON" "SIZE" "ERROR" -> "ON_SIZE_ERROR" + (the code will be more brief if we do this)*) + | {payload = TextWord "ON"; loc } :: {payload = TextWord "SIZE"; _} + :: {payload = TextWord "ERROR"; _} :: wordlist + | {payload = TextWord "SIZE"; loc} :: {payload = TextWord "ERROR"; _} :: wordlist -> + handle_conditional_statement loc ON_SIZE_ERROR wordlist state ifcheck + | {payload = TextWord "NOT"; loc } :: {payload = TextWord "ON"; _} + :: {payload = TextWord "SIZE"; _} :: {payload = TextWord "ERROR"; _}:: wordlist + | {payload = TextWord "NOT"; loc } + :: {payload = TextWord "SIZE"; _} :: {payload = TextWord "ERROR"; _}:: wordlist -> + handle_conditional_statement loc NOT_ON_SIZE_ERROR wordlist state ifcheck + | {payload = TextWord "AT"; loc} :: {payload = TextWord "END"; _} :: wordlist + | {payload = TextWord "END"; loc} :: wordlist -> + handle_conditional_statement loc AT_END wordlist state ifcheck + | {payload = TextWord "NOT"; loc} :: {payload = TextWord "AT"; _} + :: {payload = TextWord "END"; _} :: wordlist + | {payload = TextWord "NOT"; loc} :: {payload = TextWord "END"; _} :: wordlist -> + handle_conditional_statement loc NOT_AT_END wordlist state ifcheck + | {payload = TextWord "ON"; loc} :: {payload = TextWord "EXCEPTION"; _} :: wordlist + (* TODO: Find a better way to solve the keyword conflict "(ON)EXCEPTION". + the "ON EXCEPTION" can be simplified to "EXCEPTION", + but "EXCEPTION" can appear inside some statements(RAISE/GOBACK/USE) + I use a quite strange way to solve the problem (cannot be generalized) + See `check_raise_stmt` `check_goback_stmt` `check_use_stmt` + *) + | {payload = TextWord "EXCEPTION"; loc} :: wordlist -> + handle_conditional_statement loc ON_EXCEPTION wordlist state ifcheck + | {payload = TextWord "NOT"; loc} :: {payload = TextWord "ON"; _} + :: {payload = TextWord "EXCEPTION"; _} :: wordlist + | {payload = TextWord "NOT"; loc} + :: {payload = TextWord "EXCEPTION"; _} :: wordlist -> + handle_conditional_statement loc NOT_ON_EXCEPTION wordlist state ifcheck + | {payload = TextWord "INVALID"; loc } :: {payload = TextWord "KEY"; _} :: wordlist + | {payload = TextWord "INVALID"; loc } :: wordlist -> + handle_conditional_statement loc INVALID_KEY wordlist state ifcheck + | {payload = TextWord "NOT"; loc } :: {payload = TextWord "INVALID"; _} + :: {payload = TextWord "KEY"; _} :: wordlist + | {payload = TextWord "NOT"; loc } :: {payload = TextWord "INVALID"; _} + :: wordlist -> + handle_conditional_statement loc NOT_INVALID_KEY wordlist state ifcheck + | {payload = TextWord "AT"; loc } :: {payload = TextWord ("END-OF-PAGE"|"EOP"); _} :: wordlist + | {payload = TextWord ("END-OF-PAGE"|"EOP"); loc} :: wordlist -> + handle_conditional_statement loc AT_END_OF_PAGE wordlist state ifcheck + | {payload = TextWord "NOT"; loc} :: {payload = TextWord "AT"; _} + :: {payload = TextWord ("END-OF-PAGE"|"EOP"); _} :: wordlist + | {payload = TextWord "NOT"; loc} + :: {payload = TextWord ("END-OF-PAGE"|"EOP"); _} :: wordlist -> + handle_conditional_statement loc NOT_AT_END_OF_PAGE wordlist state ifcheck + | {payload = TextWord "ON"; loc } :: {payload = TextWord "OVERFLOW"; _} :: wordlist + | {payload = TextWord "OVERFLOW"; loc} :: wordlist -> + handle_conditional_statement loc ON_OVERFLOW wordlist state ifcheck + | {payload = TextWord "NOT"; loc } :: {payload = TextWord "ON"; _} + :: {payload = TextWord "OVERFLOW"; _} :: wordlist + | {payload = TextWord "NOT"; loc } + :: {payload = TextWord "OVERFLOW"; _} :: wordlist -> + handle_conditional_statement loc NOT_ON_OVERFLOW wordlist state ifcheck + + (*TODO: find a better way to distinguish PERFORM(inline) and PERFORM_CLOSED(out-of-line)*) + (*A bug here, TODO.md for details*) + | {payload = TextWord "PERFORM"; loc } :: _ :: {payload = TextWord "TIMES"; _} :: wordlist + | {payload = TextWord "PERFORM"; loc } :: {payload = TextWord ("UNTIL"|"VARYING"|"WITH"|"TEST"); _} + :: wordlist -> + handle_open_scope PERFORM loc wordlist state ifcheck + + | {payload = TextWord "ELSE"; loc} :: {payload = TextWord "IF"; _} :: wordlist -> + let context = exp_scope_termination THEN context in + begin match context with + | (THEN, _) :: (IF, _) :: context' -> + let acc = check_pos loc (offset_of_context context') acc ifcheck in + check_if_stmt wordlist {state with scope = IF; context; acc} false + | _ -> failwith @@ failure_msg loc + end +(* + | {payload = TextWord "NEXT"; loc} :: {payload = TextWord "SENTENCE"; _} :: wordlist + + The GnuCOBOL handles NEXT SENTENCE differently than described in the standard of COBOL. + According the standard 1985/1989:2014 + ``` + IF x > 1 THEN NEXT SENTENCE + DISPLAY "STH" . + ``` + This DISPLAY statement should be the next statement of IF statement. + But the result of GnuCOBOL shows that + the DISPLAY statement is inside the THEN phrase(even though it is never reached). + However, I am not sure since I cannot test the case in the mainframe. + + We must care about this case. Because the NEXT SENTENCE in fact terminates the + Then branch of IF statement, so this IF statement can be implicitly terminated. *) + + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> + check_fun state.scope wordlist state ifcheck + | TextWord word -> + begin match proc_context_of_str word with + | Compiler_directive _ -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | Close_scope keyword -> + handle_close_scope keyword loc wordlist state ifcheck + | Open_scope keyword -> + handle_open_scope keyword loc wordlist state ifcheck + + | Phrase THEN -> (*only for THEN inside INTIALIZE statement*) + handle_inline_phrase loc wordlist state ifcheck + + | Phrase keyword -> + handle_phrase keyword loc wordlist state ifcheck + | Inline_phrase -> + handle_inline_phrase loc wordlist state ifcheck + | PERIOD -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let scope = match context with + (*this case appears when indent a incomplet code, which begins directly with statement*) + (*In general we avoid defining `state.scope` to `STATEMENT`, + it is better to define `state.scope` to a specific statement like `IF`, `ADD`. + `check_statement` is an auxiliary function *) + | (BEGIN, _) :: _ -> STATEMENT + | (scope, _) :: _ -> scope + | [] -> failwith @@ failure_msg loc + in + check_proc_div wordlist {state with scope; context; acc} false + | No_keyword + | _ -> + let offset = offset_of_context context in + let acc = check_pos loc offset acc ifcheck in + check_fun state.scope wordlist {state with acc} false + end + | _ -> + let offset = offset_of_context context in + let acc = check_pos loc offset acc ifcheck in + check_fun state.scope wordlist {state with acc} false + +(* if in need, we can seperate some statements from this general statement. + ex. the `check_if_stmt` below + + in `check_if_stmt`, and `check_statement`, we handle `THEN` differently + (`THEN` inside `IF` statement or `INITIALIZE` statement) + of course, we can remove `check_if_stmt`, and add the check of context in + `handle_then` to make it work correctly + + we can define the check_accept, check_display... for each statement, + however, there are too many duplicate code to write... + we could do that if the finer analysis is needed. *) +and check_if_stmt (text:text) state ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> + check_if_stmt wordlist state ifcheck + | TextWord word -> + begin match proc_context_of_str word with + | Compiler_directive _ -> + check_copy_replace text {state with scope = COPY_REPLACE} ifcheck + | Phrase THEN -> + handle_if_then loc wordlist state ifcheck + | Open_scope keyword -> + handle_open_scope keyword loc wordlist state ifcheck + | No_keyword -> + let offset = offset_of_context context in + let acc = check_pos loc offset acc ifcheck in + check_if_stmt wordlist {state with acc} false + (*other case, call the general function*) + | _ -> check_statement text state ifcheck + end + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_if_stmt wordlist {state with acc} false + +(* TODO: Find a better way to solve the keyword conflict "(ON)EXCEPTION"*) +(*`check_raise_stmt`, `check_goback_stmt`, `check_use_stmt` are to solve the keyword conflict of "EXCEPTION"*) +(* the idea: when the RAISE/GOBACK/USE statement do not allow an "EXCEPTION" phrase any more, + add a DUMMY token onto the `context`, + when check the wordlist, check the `context` top, if there is a DUMMY token, + call `check_statement` *) +and check_raise_stmt (text:text) state ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> + check_raise_stmt wordlist state ifcheck + | TextWord _ when context = [] || fst @@ List.hd context <> DUMMY_EXCEPTION -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context DUMMY_EXCEPTION context in + check_raise_stmt wordlist {state with acc; context} false + | _ -> + check_statement text state ifcheck + +and check_goback_stmt (text:text) state ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> + check_goback_stmt wordlist state ifcheck + | TextWord "." -> + let context = handle_period context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let scope = match context with + | (BEGIN, _) :: _ -> STATEMENT (*ERROR PRONE*) + | (scope, _) :: _ -> scope + | [] -> failwith @@ failure_msg loc + in + check_proc_div wordlist {state with scope; context; acc} false + | TextWord "RAISING" -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context RAISING context in + check_goback_stmt wordlist {state with context; acc} false + | TextWord "LAST" + (*"GOBACK [RAISING LAST EXCEPTION]"*) + when context <> [] && fst @@ List.hd context = RAISING -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_goback_stmt wordlist {state with acc} false + | TextWord _ + when context <> [] && fst @@ List.hd context = RAISING -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context DUMMY_EXCEPTION context in + check_goback_stmt wordlist {state with context; acc} false + | _ -> + check_statement text state ifcheck + +and check_use_stmt (text:text) state ifcheck = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> + check_use_stmt wordlist state ifcheck + | TextWord ("GLOBAL"|"AFTER"|"STANDARD") -> + (*the keyword which can appear before "EXCEPTION"*) + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_use_stmt wordlist {state with acc} false + | TextWord _ when context = [] || fst @@ List.hd context <> DUMMY_EXCEPTION -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context DUMMY_EXCEPTION context in + check_use_stmt wordlist {state with acc; context} false + | _ -> + check_statement text state ifcheck +(* / *) + +(*For alignment of arguments*) +(*fst_arg: if is the first argument in the line*) +and check_arguments (text:text) state ifcheck ~fst_arg = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist -> + begin match payload with + | CDirWord _ -> check_arguments wordlist state ifcheck ~fst_arg + | TextWord word -> + begin match proc_context_of_str word with + | No_keyword when fst_arg -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let pos = start_pos loc in + let offset = pos.pos_cnum - pos.pos_bol in + let offset_change = + match acc with + | [] -> 0 + | {lnum; _} :: _ when lnum <> pos.pos_lnum -> 0 + | x :: _ -> x.offset_modif - x.offset_orig + in + let context = + match context with + | (ARGUMENT, _) :: context' -> + (ARGUMENT, offset + offset_change) :: context' + | _ -> failwith @@ failure_msg loc + in + check_arguments wordlist {state with acc; context} false ~fst_arg:false + | No_keyword -> check_arguments wordlist state false ~fst_arg:false + | _ -> + let scope, context = + match context with + | (ARGUMENT, _) :: ((TO|FROM|INTO|BY|GIVING), _) :: ((prev, _) :: _ as context) + | (ARGUMENT, _) :: ((prev, _) :: _ as context) -> prev, context + | _ -> failwith @@ failure_msg loc + in + check_fun scope text {state with scope; context} ifcheck + end + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_arguments wordlist {state with acc} false ~fst_arg + end + +and check_add_stmt (text:text) state ifcheck = + match text with + | [] -> state + | {payload; loc} :: wordlist -> + match payload with + | CDirWord _ -> check_add_stmt wordlist state ifcheck + | TextWord word -> + begin match proc_context_of_str word with + | No_keyword -> + let context = push_context ARGUMENT state.context in + check_arguments text {state with scope = ARGUMENT; context} ifcheck ~fst_arg:true + | Phrase keyword -> handle_phrase keyword loc wordlist state ifcheck + | _ -> check_statement text state ifcheck + end + | _ -> failwith @@ failure_msg loc + +and check_subtract_stmt text state ifcheck = check_add_stmt text state ifcheck +and check_multiply_stmt text state ifcheck = check_add_stmt text state ifcheck +and check_divide_stmt text state ifcheck = check_add_stmt text state ifcheck +(* / *) + + +(* there are some handle_functions. + different from check_function, + the check_function will call itself again (possibly stay in its scope) (except `check_statement`) + the handle_function handles one token and go directly to another scope *) +and handle_open_scope keyword loc wordlist state ifcheck = + let context = imp_scope_termination state.context in + let offset = offset_of_context context in + let acc = check_pos loc offset state.acc ifcheck in + let context = push_context keyword context in + match keyword with + (*TODO: find a better way to handle the nested IF statement. + If need to indent the condition expression, must change this*) + | IF -> + let context = push_context THEN context in + check_fun keyword wordlist {state with scope = keyword; context; acc} false + | _ -> + check_fun keyword wordlist {state with scope = keyword; context; acc} false + +and handle_close_scope keyword loc wordlist state ifcheck = + let context = exp_scope_termination keyword state.context in + match context with + | (key, _) :: ((prev, offset) :: _ as context) when key = keyword -> + let acc = check_pos loc offset state.acc ifcheck in + let scope = + (*this case appears when indent a incomplet code, which begins directly with statement*) + (*In general we avoid defining `state.scope` to `STATEMENT`, + it is better to define `state.scope` to a specific statement like `IF`, `ADD`. + `check_statement` is an auxiliary function *) + if prev = BEGIN then STATEMENT + else prev + in + check_fun scope wordlist {state with scope; context; acc} false + | _ -> failwith @@ failure_msg loc + +and handle_if_then loc wordlist state ifcheck = + let context = imp_scope_termination state.context in + match context with + | (THEN, _):: (IF, _) :: context' -> + let acc = check_pos loc (offset_of_context context') state.acc ifcheck in + check_fun state.scope wordlist {state with scope = THEN; context; acc} false + | _ -> + failwith @@ failure_msg loc + +and handle_else loc wordlist state ifcheck = + let context = exp_scope_termination THEN state.context in + match context with + | (THEN, _) :: ((IF, _) :: context' as context) -> + let acc = check_pos loc (offset_of_context context') state.acc ifcheck in + let context = push_context ELSE context in + check_fun state.scope wordlist {state with scope = ELSE; context; acc} false + |_ -> + failwith @@ failure_msg loc + +(*for alignment of argument*) +and handle_operator keyword loc wordlist state ifcheck = + let context = phrase_termination state.context in + let offset = offset_of_context context in + let acc = check_pos loc offset state.acc ifcheck in + let context = push_context keyword context in + let context = push_context ARGUMENT context in + check_arguments wordlist {state with acc; context; scope = ARGUMENT} false ~fst_arg:true + +and handle_to loc wordlist state ifcheck = + handle_operator TO loc wordlist state ifcheck + +and handle_into loc wordlist state ifcheck = + handle_operator INTO loc wordlist state ifcheck + +and handle_from loc wordlist state ifcheck = + handle_operator FROM loc wordlist state ifcheck + +and handle_giving loc wordlist state ifcheck = + handle_operator GIVING loc wordlist state ifcheck + +and handle_by loc wordlist state ifcheck = + let context = phrase_termination_until USING state.context in + let offset = offset_of_context context in + let acc = check_pos loc offset state.acc ifcheck in + let context = push_context BY context in + let context = push_context ARGUMENT context in + check_arguments wordlist {state with acc; context; scope = ARGUMENT} false ~fst_arg:true + +(*using-phrase is the only phrase that we treat more carefully + using-phrase can contain by content/reference phrase. *) +and handle_using loc text state ifcheck = + let context = phrase_termination state.context in + let offset = offset_of_context context in + let acc = check_pos loc offset state.acc ifcheck in + let context = push_context USING context in + check_using text {state with acc; context; scope = USING} false + +and check_using (text:text) state ifcheck = + match text with + | [] -> state + | {payload = TextWord "BY"; loc} :: {payload = TextWord ("REFERENCE"|"CONTENT"|"VALUE"); _} :: wordlist + | {payload = TextWord ("REFERENCE"|"CONTENT"|"VALUE"); loc} :: wordlist -> + handle_by loc wordlist state ifcheck + | {payload = TextWord word; _} :: _ -> + begin match proc_context_of_str word with + | No_keyword -> + let context = push_context ARGUMENT state.context in + check_arguments text {state with context; scope = ARGUMENT} ifcheck ~fst_arg:true + | _ -> check_statement text state ifcheck + (*Since using-phrase alse appears in the procedure division header, + it is not appropriate to call check_statement here. + However, no bug found untilnow.*) + end + | _ -> check_statement text state ifcheck +(* / *) + + +and handle_phrase keyword loc wordlist state ifcheck = + match keyword with + | TO -> handle_to loc wordlist state ifcheck + | INTO -> handle_into loc wordlist state ifcheck + | GIVING -> handle_giving loc wordlist state ifcheck + | FROM -> handle_from loc wordlist state ifcheck + | BY -> handle_by loc wordlist state ifcheck + | USING -> handle_using loc wordlist state ifcheck + | ELSE -> handle_else loc wordlist state ifcheck + | WHEN -> handle_when loc wordlist state ifcheck + | _ -> + let context = phrase_termination state.context in + let offset = offset_of_context context in + let acc = check_pos loc offset state.acc ifcheck in + match context with + | (prev, _) :: _ -> + let context = push_context keyword context in + check_fun prev wordlist {state with scope = prev; context; acc} false + | _ -> failwith @@ failure_msg loc + +and handle_inline_phrase loc wordlist state ifcheck = + let context = phrase_termination state.context in + let offset = offset_of_context context in + let acc = check_pos loc offset state.acc ifcheck in + match context with + | (prev, _) :: _ -> + check_fun prev wordlist {state with scope = prev; context; acc} false + | _ -> failwith @@ failure_msg loc + + +and handle_conditional_statement loc keyword wordlist state ifcheck = + let help keyword rev_keyword keyword_associated = + let context, acc = state.context, state.acc in + let context = phrase_termination context in + match context with + (*special case, SEARCH statement contains only `AT_END` but not `NOT_AT_END`*) + | (SEARCH, offset) :: _ when keyword = AT_END -> + let acc = check_pos loc offset acc ifcheck in + let context = push_context SEARCH_AT_END context in + check_fun keyword wordlist {state with scope = keyword; context; acc} false + (* take `ON_SIZE_ERROR` for an example*) + (* when the `ON_SIZE_ERROR` is just after an `ADD`, it must match this `ADD`*) + | (key, offset) :: _ when List.mem key keyword_associated -> + let acc = check_pos loc offset acc ifcheck in + let context = push_context keyword context in + check_fun keyword wordlist {state with scope = keyword; context; acc} false + (* when the `ON_SIZE_ERROR` is not just after `ADD`, + there must be a `NOT_ON_SIZE_ERROR` in the `context`, match them*) + | _ -> + let context = exp_scope_termination rev_keyword context in + match context with + | (key, _) :: context when key = rev_keyword -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context HELPTOKEN context in + check_fun keyword wordlist {state with scope = keyword; context; acc} false + | _ -> failwith @@ failure_msg loc + in + match keyword with + | ON_SIZE_ERROR -> + help ON_SIZE_ERROR NOT_ON_SIZE_ERROR [ADD; SUBTRACT; MULTIPLY; DIVIDE; COMPUTE] + | NOT_ON_SIZE_ERROR -> + help NOT_ON_SIZE_ERROR ON_SIZE_ERROR [ADD; SUBTRACT; MULTIPLY; DIVIDE; COMPUTE] + | AT_END -> + help AT_END NOT_AT_END [READ; RETURN; SEARCH] + | NOT_AT_END -> + help NOT_AT_END AT_END [READ; RETURN; SEARCH] + | ON_EXCEPTION -> + help ON_EXCEPTION NOT_ON_EXCEPTION [ACCEPT; CALL; DISPLAY] + | NOT_ON_EXCEPTION -> + help NOT_ON_EXCEPTION ON_EXCEPTION [ACCEPT; CALL; DISPLAY] + | INVALID_KEY -> + help INVALID_KEY NOT_INVALID_KEY [READ; WRITE; REWRITE; START; DELETE] + | NOT_INVALID_KEY -> + help NOT_INVALID_KEY INVALID_KEY [READ; WRITE; REWRITE; START; DELETE] + | AT_END_OF_PAGE -> + help AT_END_OF_PAGE NOT_AT_END_OF_PAGE [WRITE] + | NOT_AT_END_OF_PAGE -> + help NOT_AT_END_OF_PAGE AT_END_OF_PAGE [WRITE] + | ON_OVERFLOW -> + help ON_OVERFLOW NOT_ON_OVERFLOW [CALL; STRING; UNSTRING] + | NOT_ON_OVERFLOW -> + help NOT_ON_OVERFLOW ON_OVERFLOW [CALL; STRING; UNSTRING] + | _ -> failwith @@ failure_msg loc + + +and handle_when loc wordlist state ifcheck = + let context = phrase_termination state.context in + match context with + | (key, offset) :: _ when key = EVALUATE || key = SEARCH -> + let acc = check_pos loc offset state.acc ifcheck in + let context = push_context WHEN context in + check_fun state.scope wordlist {state with scope = WHEN; context; acc} false + | _ -> + let rec pop_until_ context = + match context with + | (key, _) :: context when (key <> SEARCH_AT_END) && (key <> WHEN) -> + pop_until_ context + | _ -> context + in + let context = pop_until_ context in + match context with + | (WHEN, _) :: context' -> + let acc = check_pos loc (offset_of_context context') state.acc ifcheck in + check_fun state.scope wordlist {state with scope = WHEN; context; acc} false + | (SEARCH_AT_END, _) :: context -> + let acc = check_pos loc (offset_of_context context) state.acc ifcheck in + let context = push_context WHEN context in + check_fun state.scope wordlist {state with scope = WHEN; context; acc} false + | _ -> + failwith @@ failure_msg loc + + +and end_compilation_unit loc wordlist ({context; acc; _} as state) ifcheck = + let context = exp_scope_termination COMPILATION_UNIT context in + let context = + match context with + | (COMPILATION_UNIT, _) :: context -> context + | _ -> failwith @@ failure_msg loc + in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_ident_div wordlist {state with scope = IDENT_DIV; context; acc} false + + +(*Remark: if the COPY does not copy a complete paragraph/statement/data entry..., + but a phrase/clause/identifier..., the check_copy_replace does not work *) +and check_copy_replace (text:text) (state:indent_state) (ifcheck:bool) = + let context, acc = state.context, state.acc in + match text with + | [] -> state + | {payload; loc} :: wordlist -> + let pos = start_pos loc in + begin match payload with + | TextWord "COPY" -> + let offset_orig = pos.pos_cnum - pos.pos_bol in + (*no check*) + let offset = offset_orig + offset_of_keyword COPY in + let context = (COPY, offset) :: context in + check_copy_replace wordlist {state with context} false + | TextWord "REPLACE" -> + let offset_orig = pos.pos_cnum - pos.pos_bol in + (*no check*) + let offset = offset_orig + offset_of_keyword REPLACE in + let context = (REPLACE, offset) :: context in + check_copy_replace wordlist {state with context} false + | TextWord "REPLACING" -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let context = push_context REPLACING_COPY context in + check_copy_replace wordlist {state with context; acc} false + | TextWord "." -> + let rec help context = + match context with + | ((REPLACING_COPY|COPY|REPLACE), _) :: context -> + help context + | _ -> context + in + let context = help context in + let acc = check_pos loc (offset_of_context context) acc ifcheck in + let scope = (*ERROR-PRONE*) + if context = [] then failwith @@ failure_msg loc + else fst @@ List.hd context + in + check_fun scope wordlist + {state with scope; context; acc} + false + | _ -> + let acc = check_pos loc (offset_of_context context) acc ifcheck in + check_copy_replace wordlist {state with context; acc} false + end + + +(***********************************) +(* in order to indent incomplete souce code + the indenter must infer the scope where the code begins. + + The inference is limited. + It works only if the code begins with + - division + - section + - paragraph (*line begins with "No_keyword ." will be infered as paragraph*) + - entry (*line begins with number will be infered as level-numbr*) + - statement + - COPY/REPLACE + + The inference function does not handle any keyword but does the inference + and return the call of + - `check_ident_div` + - `check_end_div` + - `check_data_div` + - `check_proc_header_div` + - `check_proc_div` + - `check_statement` + - `check_copy_replace` + + (**WARNING**) + we cannot return the call of `check_if_stmt`, `check_RD` or `check_data_desc` + Because the keyword "IF" is not handled inside `check_if_stmt` but handled by the previous layer. + the keyword "RD" is not handled inside `check_RD` but handled inside `check_data_div` ... + + Due to the incomplete code, the indentation becomes error-prone, must consider all possible cases + when pop the context. +*) +and infer_scope (text:text) (state:indent_state) ifcheck = + let base_context loc = + let base_offset = + let pos = start_pos loc in + pos.pos_cnum - pos.pos_bol + in + [(BEGIN, base_offset)] + in + match text with + (*jump to COPY_REPLACE*) + | {payload = TextWord ("COPY"|"REPLACE"); loc} :: _ -> + let context = base_context loc in + check_copy_replace text {state with scope = COPY_REPLACE; context} ifcheck + (*jump to IDENTIFICATION DIVISION*) + | {payload = TextWord "IDENTIFICATION"; loc} :: {payload = TextWord "DIVISION"; _} + :: {payload = TextWord "."; _} ::_ + | {payload = TextWord ("PROGRAM-ID"|"CLASS-ID"|"FACTORY"|"FUCNTION-ID"|"INTERFACE-ID" + |"METHOD-ID"|"OBJECT"|"OPTIONS"|"AUTHOR"|"DATE-WRITTEN"|"INSTALLATION"|"SECURITY"|"DATE-COMPILED"); loc} + :: {payload = TextWord "."; _} :: _ -> + let context = base_context loc in + check_ident_div text {state with scope = IDENT_DIV; context} ifcheck + (*jump to ENVIRONMENT DIVISION*) + | {payload = TextWord "NVIRONMENT"; loc} :: {payload = TextWord "DIVISION"; _} + :: {payload = TextWord "."; _} :: _ + | {payload = TextWord ("INPUT-OUTPUT"|"CONFIGURATION"); loc } :: {payload = TextWord "SECTION"; _} + :: {payload = TextWord "."; _} :: _ + | {payload = TextWord ("SOURCE-COMPUTER"|"OBJECT-COMPUTER"|"SPECIAL-NAMES"|"REPOSITORY" + |"FILE-CONTROL"|"I-O-CONTROL"); loc} :: {payload = TextWord "."; _} :: _ + | {payload = TextWord "SELECT";loc} :: _ -> + let context = base_context loc in + check_env_div text {state with scope = ENV_DIV; context} ifcheck + (*jump to DATA DIVISION*) + | {payload = TextWord "DATA"; loc} :: {payload = TextWord "DIVISION"; _} :: _ + | {payload = TextWord ("FILE"|"WORKING-STORAGE"|"LOCAL-STORAGE"|"LINKAGE"|"REPORT"|"SCREEN"); loc } + :: {payload = TextWord "SECTION"; _} :: {payload = TextWord "."; _} :: _ + | {payload = TextWord ("FD"|"RD"|"SD"); loc } :: _ -> + let context = base_context loc in + check_data_div text {state with scope = DATA_DIV; context} ifcheck + | {payload = TextWord str; loc } :: {payload = TextWord str2;_} :: _ + when ifcheck && is_data_decl str && str2 <> "." -> + let context = base_context loc in + check_data_div text {state with scope = DATA_DIV; context} ifcheck + (*jump to PROCEDURE DIVISION header*) + | {payload = TextWord "PROCEDURE"; loc} :: {payload = TextWord "DIVISION"; _} :: _ -> + let context = base_context loc in + check_proc_div_header text {state with scope = PROC_DIV_HEADER; context} ifcheck + (*jump to PROCEDURE DIVISION*) + | {payload = TextWord "DECLARATIVES" ; loc} :: _ + | {payload = TextWord "END"; loc} :: _ -> + let context = base_context loc in + check_proc_div text {state with scope = PROC_DIV; context} ifcheck + | {payload = TextWord str; loc} :: {payload = TextWord "SECTION"; _} + :: {payload = TextWord "."; _} :: _ + | {payload = TextWord str; loc} :: {payload = TextWord "."; _} :: _ + when not @@ is_statement str -> + let context = base_context loc in + check_proc_div text {state with scope = PROC_DIV; context} ifcheck + | {payload = TextWord str; loc} :: _ + when is_statement str -> + let context = base_context loc in + begin match proc_context_of_str str with + | Open_scope key -> + check_statement text {state with scope = key; context} ifcheck + | _ -> failwith @@ failure_msg loc + end + | [] -> state + | {payload = TextWord str; loc} :: _-> + failwith ("error infer division: "^str^failure_msg loc ) + | {loc;_ } :: _ -> failwith @@ "error infer division" ^ failure_msg loc + + +and check_fun = function + | BEGIN -> infer_scope + | COPY_REPLACE -> check_copy_replace + | IDENT_DIV -> check_ident_div + | ENV_DIV -> check_env_div + | DATA_DIV | LEVEL _ -> check_data_div + | DATA_DESC -> check_data_desc + | FD -> check_FD + | RD -> check_RD + | SD -> check_SD + | PROC_DIV_HEADER -> check_proc_div_header + | PROC_DIV | SECTION | PARAGRAPH | DECLARATIVES -> + check_proc_div + | IF -> check_if_stmt + | RAISE -> check_raise_stmt + | GOBACK -> check_goback_stmt + | USE -> check_use_stmt + | ARGUMENT -> check_arguments ~fst_arg:true + | ADD -> check_add_stmt + | SUBTRACT -> check_subtract_stmt + | MULTIPLY -> check_multiply_stmt + | DIVIDE -> check_divide_stmt + | USING -> check_using + | STATEMENT | _ -> check_statement + + +let check_indentation (text:text) (state:indent_state) = + match state.range with + | None -> + check_fun state.scope text state true + | Some {start_line; end_line} -> + let lnum = + match text with + | {loc; _} :: _ -> + (start_pos loc).pos_lnum + | _ -> 0 + in + if (lnum >= start_line) && (lnum <= end_line) then + check_fun state.scope text state true + else + state diff --git a/src/lsp/cobol_indent/indent_check.mli b/src/lsp/cobol_indent/indent_check.mli new file mode 100644 index 000000000..e5f3b9508 --- /dev/null +++ b/src/lsp/cobol_indent/indent_check.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val check_indentation + :Cobol_preproc.Text.t + -> Indent_type.indent_state + -> Indent_type.indent_state diff --git a/src/lsp/cobol_indent/indent_config.ml b/src/lsp/cobol_indent/indent_config.ml new file mode 100644 index 000000000..2125523eb --- /dev/null +++ b/src/lsp/cobol_indent/indent_config.ml @@ -0,0 +1,82 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Indent_type +open Indent_keywords + + +(* +TODO: + Need to be rewritten, + like ocp-indent, we may let the client to decide if + it activates some features like alignment of argument +*) + +(*we read the file user_def, and save it into the Hashtable offset_table*) +let rec build_table strlist offset_table = + let help str1 = + let str2 = String.split_on_char ';' str1 in + let name = List.hd str2 in + let value = List.nth str2 1 in + name, Int32.to_int @@ Int32.of_string value + in + match strlist with + | "" :: _ -> () + | str :: stl -> + let x,y = help str in + Hashtbl.add offset_table x y; + build_table stl offset_table + | _ -> () + +let offset_table = Hashtbl.create 16 +(*default offset table*) +let () = + List.iter + (fun (a, b) -> Hashtbl.add offset_table a b) + [ "DEFAULT", 4; (* DEFAULT offset *) (*Do not remove this one*) + "DISPLAY", 8; + "USING", 6; + "REPLACING_COPY", 10; + "INTO", 5; + "REPLACE", 8; + "SELECT", 7; + "PARAGRAPH", 4; + (*if need to indent the nested-program, set "PROC_DIV" to no zero*) + "PROC_DIV", 1; + (*if need to show more information about the different hierarchy of code, + these offsets can be set *) + "IDENT_DIV", 0; + "ENV_DIV", 0; + "DATA_DIV", 0; + "DECLARATIVES", 0; + "SECTION", 0 ] + +let set_config ~indent_config = + let str = Ez_file.V1.EzFile.read_file indent_config in + let strlist = String.split_on_char '\n' str in + build_table strlist offset_table + +let offset_of_keyword keyword = + match keyword with + (*WARNING: these tokens must have offset 0*) + | COMPILATION_UNIT + | DATA_DESC + | THEN | ELSE + | DUMMY_EXCEPTION + | ARGUMENT -> 0 + | _ -> + let str = string_of_keyword keyword in + match Hashtbl.find_opt offset_table str with + | Some x -> x + | None -> + try Hashtbl.find offset_table "DEFAULT" with Not_found -> 0 diff --git a/src/lsp/cobol_indent/indent_config.mli b/src/lsp/cobol_indent/indent_config.mli new file mode 100644 index 000000000..d5661f506 --- /dev/null +++ b/src/lsp/cobol_indent/indent_config.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(*set the indentation configuration*) +val set_config : indent_config:string -> unit + +val offset_of_keyword: Indent_type.context_kind -> int diff --git a/src/lsp/cobol_indent/indent_keywords.ml b/src/lsp/cobol_indent/indent_keywords.ml new file mode 100644 index 000000000..366841b04 --- /dev/null +++ b/src/lsp/cobol_indent/indent_keywords.ml @@ -0,0 +1,179 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Indent_type + +(*data division *) +let data_context_of_str : string -> data_context = function + | "." -> PERIOD + | "COPY" -> Compiler_directive COPY + | "REPLACE" -> Compiler_directive REPLACE + | "FD" -> Entry FD + | "RD" -> Entry RD + | "SD" -> Entry SD + | s when (s >= "1" && s <= "9") + || (s >= "01" && s <= "99") -> + let level = Int32.to_int @@ Int32.of_string s in + Entry (LEVEL level) + | _ -> No_keyword + + +(*procedure division*) + +(*keyword of statement*) +let keyword_stmt = + [ (*standard 1989*) + "ACCEPT"; "ADD"; "ALLOCATE"; "CALL"; "CANCEL"; "CLOSE"; "COMPUTE"; "CONTINUE"; + "DELETE"; "DISPLAY"; "DIVIDE"; "EVALUATE"; "EXIT"; "FREE"; + "GENERATE"; "GO"; "GOBACK"; "IF"; "INITIALIZE"; "INITIATE"; "INSPECT"; "INVOKE"; + "MERGE"; "MOVE"; "MULTIPLY"; "OPEN"; "PERFORM"; + "RAISE"; "READ"; "RELEASE"; "RESUME"; "RETURN"; "REWRITE"; + "SEARCH"; "SET"; "SORT"; "STOP"; "START"; "STRING"; "SUBTRACT"; "SUPPRESS"; + "TERMINATE"; "UNLOCK"; "UNSTRING"; "USE"; "VALIDATE"; "WRITE"; + (*standard 1985*) + "ALTER"; "DISABLE"; "ENABLE"; "PURGE"; "RECEIVE"; "SEND";] +let keyword_stmt_tbl = Hashtbl.create 16 +let () = + List.iter (fun x -> + Hashtbl.add keyword_stmt_tbl x ()) + keyword_stmt +let is_statement = Hashtbl.mem keyword_stmt_tbl + + +let str_proc_keyword_tbl = Hashtbl.create 16 +let keyword_str_tbl = Hashtbl.create 16 + +let () = + (*add statement with end-xxx*) + List.iter + (fun (a, b) -> + Open_scope b |> Hashtbl.add str_proc_keyword_tbl a; + Close_scope b |> Hashtbl.add str_proc_keyword_tbl ("END-"^a); + Hashtbl.add keyword_str_tbl b a) + [ ("ACCEPT", ACCEPT); ("ADD", ADD); ("CALL", CALL); ("COMPUTE", COMPUTE); + ("DELETE", DELETE); ("DISPLAY", DISPLAY); ("DIVIDE", DIVIDE); + ("EVALUATE", EVALUATE); ("IF", IF); ("MULTIPLY", MULTIPLY); + ("READ", READ); ("RETURN", RETURN); ("REWRITE", REWRITE); + ("SEARCH", SEARCH); ("START", START); ("STRING", STRING); + ("SUBTRACT", SUBTRACT); ("UNSTRING", UNSTRING); ("WRITE", WRITE)]; + + List.iter + (fun (a, b) -> + Open_scope b |> Hashtbl.add str_proc_keyword_tbl a; + Hashtbl.add keyword_str_tbl b a) + [ (*without END-XXX *) + ("ALLOCATE", ALLOCATE); ("CANCEL", CANCEL); ("CLOSE", CLOSE); ("CONTINUE", CONTINUE); + ("EXIT", EXIT); ("FREE", FREE); ("GENERATE", GENERATE); ("GO", GO); + ("GOBACK", GOBACK); ("INITIALIZE", INITIALIZE); ("INITIATE", INITIATE); + ("INSPECT", INSPECT); ("INVOKE", INVOKE); ("MERGE", MERGE); ("MOVE", MOVE); + ("OPEN", OPEN); ("RAISE", RAISE); ("RELEASE", RELEASE); ("RESUME", RESUME); + ("SET", SET); ("SORT", SORT); ("STOP", STOP); ("SUPPRESS", SUPPRESS); + ("TERMINATE", TERMINATE); ("UNLOCK", UNLOCK); ("USE", USE); ("VALIDATE", VALIDATE); + (*standard 1985*) + ("ALTER", ALTER); ("DISABLE", DISABLE); ("ENABLE", ENABLE); + ("PURGE", PURGE); ("RECEIVE", RECEIVE); ("SEND", SEND);]; + + (*add other keyword (phrase/clause inside statement)*) + List.iter + (fun (a, b) -> + Hashtbl.add str_proc_keyword_tbl a (Phrase b); + Hashtbl.add keyword_str_tbl b a) + [ ("AFTER", AFTER); ("AT", AT); ("BEFORE", BEFORE); ("BY", BY); + ("CONVERTING", CONVERTING); ("ELSE", ELSE); ("FROM", FROM); + ("GIVING", GIVING); ("INTO", INTO); ("REPLACING", REPLACING); + ("SEQUENCE", SEQUENCE); ("TALLYING", TALLYING); ("THEN", THEN); + ("TO", TO); ("UNTIL", UNTIL); ("USING", USING); ("VARYING", VARYING); + ("WHEN", WHEN); ("RAISING", RAISING) ]; + + (*add inline_phrase*) + List.iter + (fun a -> Hashtbl.add str_proc_keyword_tbl a Inline_phrase) + [ "INITIALIZED"; "RETURNING"; "REMAINDER"; + "INPUT"; "OUTPUT"; "WITH"; "ADVANCING"; + "IGNORING"; "DEFAULT"; "SHARING"; "LOCK"; "POINTER"]; + + (*For now, Other_keyword is only for avoiding bugs in check_argument *) + List.iter + (fun a -> Hashtbl.add str_proc_keyword_tbl a Other_keyword) + [ "ON"; "SIZE"; "ERROR"; "NOT"; "EXCEPTION"; "OVERFLOW"; + "END"; "EXCEPTION"; "INVALID"; "KEY"; "PAGE"; "EOP"]; + (*special case*) + List.iter (fun (a, b) -> Hashtbl.add str_proc_keyword_tbl a b) + [ ( ".", PERIOD); + ("COPY", Compiler_directive COPY); + ("REPLACE", Compiler_directive REPLACE); + (*special case*) + ("PERFORM", Open_scope PERFORM_CLOSED); + ("END-PERFORM", Close_scope PERFORM)] + +(*add other keywords into keyword_str_tbl*) +let () = + List.iter + (fun (a, b) -> Hashtbl.add keyword_str_tbl a b) + [ (COPY, "COPY"); (REPLACING_COPY, "REPLACING_COPY"); (REPLACE, "REPLACE"); + (IDENT_DIV, "IDENT_DIV"); (ENV_DIV, "ENV_DIV"); (SELECT, "SELECT"); + (DATA_DIV, "DATA_DIV"); (DATA_DESC, "DATA_DESC"); + (FD, "FD"); (SD, "SD"); (RD, "RD"); (DATA_DIV_CLAUSE, "DATA_DIV_CLAUSE"); + (PROC_DIV, "PROC_DIV"); (SECTION, "SECTION"); (PARAGRAPH, "PARAGRAPH"); + (DECLARATIVES, "DECLARATIVES"); (COMPILATION_UNIT, "COMPILATION_UNIT"); + + (ON_SIZE_ERROR, "ON_SIZE_ERROR"); (NOT_ON_SIZE_ERROR, "NOT_ON_SIZE_ERROR"); + (ON_EXCEPTION, "ON_EXCEPTION"); (NOT_ON_EXCEPTION, "NOT_ON_EXCEPTION"); + (INVALID_KEY, "INVALID_KEY"); (NOT_INVALID_KEY, "NOT_INVALID_KEY"); + (AT_END_OF_PAGE, "AT_END_OF_PAGE"); (NOT_AT_END_OF_PAGE, "NOT_AT_END_OF_PAGE"); + (ON_OVERFLOW, "ON_OVERFLOW"); (NOT_ON_OVERFLOW, "NOT_ON_OVERFLOW"); + (AT_END, "AT_END"); (NOT_AT_END, "NOT_AT_END"); + (PERFORM, "PERFORM"); (PERFORM_CLOSED, "PERFORM"); + (DUMMY_EXCEPTION, "DUMMY_EXCEPTION")] + + +let proc_context_of_str str = + match Hashtbl.find_opt str_proc_keyword_tbl str with + | Some x -> x + | _ -> No_keyword + +let string_of_keyword keyword = + match Hashtbl.find_opt keyword_str_tbl keyword with + | Some x -> x + | _ -> "DEFAULT" + + +(*not implicitly terminable*) +let keyword_not_imp_terminable = Hashtbl.create 16 +let () = + List.iter (fun a -> Hashtbl.add keyword_not_imp_terminable a ()) + [ + IF; WHEN; PERFORM; THEN; ELSE; + ON_SIZE_ERROR; NOT_ON_SIZE_ERROR; HELPTOKEN; + ON_EXCEPTION; NOT_ON_EXCEPTION; + ON_OVERFLOW; NOT_ON_OVERFLOW; + AT_END; NOT_AT_END; SEARCH_AT_END; + AT_END_OF_PAGE; NOT_AT_END_OF_PAGE; + INVALID_KEY; NOT_INVALID_KEY; + + IDENT_DIV; ENV_DIV; DATA_DIV; PROC_DIV; + DECLARATIVES; PARAGRAPH; SECTION; + BEGIN; COMPILATION_UNIT; + ] +let is_not_imp_terminable = Hashtbl.mem keyword_not_imp_terminable + + +let keyword_phrase = Hashtbl.create 16 +let () = + List.iter (fun a -> Hashtbl.add keyword_phrase a ()) + [ + USING; REPLACING; TALLYING; SEQUENCE; TO; + GIVING; AT; INTO; VARYING; AFTER; UNTIL; + FROM; BY; ARGUMENT + ] +let is_phrase = Hashtbl.mem keyword_phrase diff --git a/src/lsp/cobol_indent/indent_keywords.mli b/src/lsp/cobol_indent/indent_keywords.mli new file mode 100644 index 000000000..17bdfb8fd --- /dev/null +++ b/src/lsp/cobol_indent/indent_keywords.mli @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val string_of_keyword: Indent_type.context_kind -> string + +val data_context_of_str: string -> Indent_type.data_context + +val proc_context_of_str: string -> Indent_type.proc_context + +(* To check whether the string is a keyword of statement *) +val is_statement: string -> bool + +(* To check whether the keyword is implicitly terminable *) +val is_not_imp_terminable: Indent_type.context_kind -> bool + +(* To check whether the keyword is a keyword of phrase *) +val is_phrase: Indent_type.context_kind -> bool diff --git a/src/lsp/cobol_indent/indent_type.ml b/src/lsp/cobol_indent/indent_type.ml new file mode 100644 index 000000000..897c42eb3 --- /dev/null +++ b/src/lsp/cobol_indent/indent_type.ml @@ -0,0 +1,169 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(*TODO: this type mix the keyword(ex. MOVE) and context(ex. COMPILATION_UNIT)*) +type context_kind = + | BEGIN (*the default scope*) + | COMPILATION_UNIT (*compilation_unit*) + (* | PROGRAM| FUNCTION| CLASS| INTERFACE| FACTORY| OBJECT| METHOD *) + | COPY_REPLACE + | COPY + | REPLACING_COPY + | REPLACE + | IDENT_DIV + | ENV_DIV + | SELECT (*in FILE-CONTROL*) + + | DATA_DIV + | DATA_DESC + (*TODO: DATA_DIV_CLAUSE is the token for all clause inside data division. + define different tokens for different clauses this if need be*) + | DATA_DIV_CLAUSE + | FD | RD | SD + | LEVEL of int + (*procedure division*) + | PROC_DIV + | PROC_DIV_HEADER + | DECLARATIVES + | STATEMENT + | SECTION + | PARAGRAPH + (******token of keyword in ProcDiv******) + | ACCEPT | ADD | ALLOCATE | CALL | CANCEL | CLOSE | COMPUTE | CONTINUE + | DELETE | DISPLAY | DIVIDE | EVALUATE | EXIT | FREE + | GENERATE | GO | GOBACK | IF | INITIALIZE | INITIATE | INSPECT | INVOKE + | MERGE | MOVE | MULTIPLY | OPEN + | RAISE | READ | RELEASE | RESUME | RETURN | REWRITE + | SEARCH | SET | SORT | START | STOP | STRING | SUBTRACT | SUPPRESS + | TERMINATE | UNLOCK | UNSTRING | USE | VALIDATE | WRITE + (*specil case: + PERFORM_CLOSED can be implicitly terminated, + but PERFORM not. + ex. + "PERFORM PARA1" is PERFORM_CLOSED, it does not have the END-PERFORM; + "PERFORM 3 Times {nested-statement}" is PERFORM, it must be ended with END-PERFORM + (*TODO: according to standard ISO_IEC_1989_2014, it could be terminated by "." + but by test of gnucobol, it must be ended with a END-PERFORM... + We suppose that the "." can terminate a PERFORM statement.*) + *) + | PERFORM | PERFORM_CLOSED + (*Phrase/clause inside statement*) + | ON_SIZE_ERROR | NOT_ON_SIZE_ERROR + | AT_END | NOT_AT_END | SEARCH_AT_END + | ON_EXCEPTION | NOT_ON_EXCEPTION + | INVALID_KEY | NOT_INVALID_KEY + | AT_END_OF_PAGE | NOT_AT_END_OF_PAGE + | ON_OVERFLOW | NOT_ON_OVERFLOW + | HELPTOKEN + (* + We only implement these phrases/clauses (which influence the indentation) + Other phrases/clauses are considered as inline + *) + | AFTER (*INSPECT/PERFORM/WRITE*) + | AT (*DISPLAY/ACCEPT*) + | BEFORE (*INSPECT/PRFORM/WRITE*) + | BY (*CALL/INVOKE/DIVIDE/INITIALIZE/INSPECT/MULTIPLY/PERFORM/SET/proc-div-header*) + | CONVERTING (*INSPECT*) + | ELSE (*IF*) + | FROM (*ACCEPT/PERFORM/RELEASE/REWRITE/SUBTRACT/WRITE*) + | GIVING (*ADD/SUBTRACT/MULTIPLY/DIVIDE/MERGE/SORT*) + | INTO (*DIVIDE/READ/RETURN/STRING/UNSTRING*) + | RAISING (*EXIT/GOBACK/proc-div-header*) + | REPLACING (*INITIALIZE/INSPECT*) + | SEQUENCE (*MERGE/SORT*) (*COLLATING SEQUENCE*) + | TALLYING (*INSPECT/UNSTRING*) + | THEN (*IF*) + | TO (*ADD/INITIALIZE/INSPECT/MOVE/SET*) + | UNTIL (*PERFORM*) + | USING (*CALL/MERGE/INVOKE/SORT/proc-div-header*) + | VARYING (*SEARCH/PERFORM*) + | WHEN (*EVALUATE/SEARCH*) + + | DUMMY_EXCEPTION (*a help token to solve a bug*) + (*Not a keyword, used for alignment of argument*) + | ARGUMENT + + (*Statement of standard 1985. + To avoid possible keyword conflict, + the phrases inside these statements are not implemented *) + | ALTER | DISABLE | ENABLE | PURGE | RECEIVE | SEND + +(* data_context is used in the data division*) +type data_context = + | PERIOD + | Compiler_directive of context_kind + | Entry of context_kind + | No_keyword + +(* proc_context is used in the procedure division*) +(* When checking indentation of Procedur Division, + All "combination of keywords" will be checked first by the pattern matching + of string, + i.e. sth like "ELSE IF", "ON SIZE ERROR" ... + Then, we transform the string to token of proc_context (1 string -> 1 token) +*) +type proc_context = + | PERIOD + | Compiler_directive of context_kind + | Open_scope of context_kind + | Close_scope of context_kind + | Phrase of context_kind + (* We define Inline_phrase in order to terminate the phrase before it.*) + | Inline_phrase + (* Other word which has no influence on the indentation is mapped to + No_keyword or Other_keyword. *) + | No_keyword + | Other_keyword + +(*to record the indentation error + + lnum: the line number of the indentation error + offset_orig: original offset + offset_modif: correct offset + +ex. + _______________________ + |Para1. + | move 3 to 4. + | + + it comes an indenteur_record + {lnum = 2 (line num of "move" in the whole file i.e. pos_lnum) ; + offset_orig = 1; + offset_modif = 4 (set in user_define, offset of paragraph) } +*) +type indent_record = + { lnum:int; + offset_orig:int; + offset_modif: int} + +type range = {start_line:int; + end_line :int } + +type context = (context_kind * int) list + +type indent_state = + { + scope: context_kind; (*indicate where the current code is*) + context: context; (*the stack of (context_kind, offset)*) + acc: indent_record list; + range : range option; + + (*TODO: + - Use a new type for `scope` + - it may be strange to save range into the accumulator + since range is decided at the begin and does not change any more. + However, due to the limitation of the API "fold_text_lines", + I find no good method to do it. + *) + } diff --git a/src/lsp/cobol_indent/indent_util.ml b/src/lsp/cobol_indent/indent_util.ml new file mode 100644 index 000000000..45530e552 --- /dev/null +++ b/src/lsp/cobol_indent/indent_util.ml @@ -0,0 +1,150 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc + +open Indent_type +open Indent_keywords + +let check_pos (pos:Lexing.position) (offset:int) (ind_recds:indent_record list) ~print_errors= + let real_offset = pos.pos_cnum - pos.pos_bol in + if real_offset <> offset then + begin + if print_errors then + begin + let newsrcloc = raw (pos,pos) in + Fmt.pr "%a" Cobol_common.Srcloc.pp_srcloc newsrcloc; + Fmt.pr "Indentation error : the offset is %d, but expected offset is %d\n\n" real_offset offset + end; + {lnum = pos.pos_lnum; + offset_orig = real_offset; + offset_modif = offset } + :: ind_recds + end + else + ind_recds + +(* print_errors for debug *) +let check_pos = check_pos ~print_errors:false + +let check_pos srcloc offset ind_recds ifcheck = + if ifcheck + then + let pos = start_pos srcloc in + check_pos pos offset ind_recds + else ind_recds + +let failure_msg loc = + let pos = start_pos loc in + let lnum, cnum = pos.pos_lnum, pos.pos_cnum - pos.pos_bol in + "line: "^ (string_of_int lnum) ^" character: "^ (string_of_int cnum) + +let offset_of_keyword = Indent_config.offset_of_keyword + +let offset_of_context context = + match context with + | [] -> failwith "empty context" + | _ -> snd @@ List.hd context + +let push_context key context = + (key, offset_of_keyword key + offset_of_context context) :: context + + +(*for DATA DECLARATION*) +let is_data_decl (str:string) = + match Int32.of_string_opt str with + | None -> false + | _ -> true + +let rec reduce_level i context = + match context with + | (LEVEL j, _) :: context + when j >= i -> + reduce_level i context + | _ -> + context + +(*used for "." *) +let rec handle_period context = + match context with + | [] + | ((BEGIN | COMPILATION_UNIT + | IDENT_DIV | ENV_DIV| DATA_DIV | PROC_DIV + | DECLARATIVES | LEVEL _| PARAGRAPH | SECTION), _) :: _ -> + context + | _ :: context -> + handle_period context + +(* explicit scope termination*) +(* for END DECLARATIVES./END-XXX/ELSE/END PROGRAM/...*) +(* when using this function, [keyword] is always in [context] *) +let rec exp_scope_termination (keyword:context_kind) context = + match context with + | (x, _) :: context when x <> keyword -> + exp_scope_termination keyword context + | _ -> + context + +(* similar to exp_scope_termination, but we allow that [keyword] is not in [context]*) +(* must be careful to use [pop_until] and [exp_scope_termination]. + since we may indent a range of code, we cannot hope that the previous layer of + [keyword] is already inside [context]: + ex. maybe we indent a range of code which is a paragraph of procedure division, + then the `SECTION` `PROC_DIV` is not in the initial context + (but if we indent the whole file, `PROC_DIV` are always before `PARAGRAPH`) *) +let rec pop_until (keyword:context_kind) context = + match context with + | (( BEGIN | COMPILATION_UNIT | IDENT_DIV | DATA_DIV + | ENV_DIV | PROC_DIV | DECLARATIVES), _) :: _ -> + context + | (x, _) :: context when x <> keyword -> + pop_until keyword context + | _ -> + context + +(*pop the scope until the scope of division*) +let rec pop_until_division context = + match context with + | [] | ( (BEGIN|COMPILATION_UNIT|IDENT_DIV|DATA_DIV|ENV_DIV|PROC_DIV), _) :: _ -> context + | _ :: context -> + pop_until_division context + + +(*pop the scope until the scope of compilation_unit*) +let rec pop_until_compilation_unit context = + match context with + | [] | ( (BEGIN|COMPILATION_UNIT), _) :: _ -> context + | _ :: context -> pop_until_compilation_unit context + + +(*implicit scope termination*) +let rec imp_scope_termination context = + match context with + | (keyword, _) :: context + when not @@ is_not_imp_terminable keyword -> + imp_scope_termination context + | _ -> context + +(*terminate phrase inside statement*) +let rec phrase_termination context = + match context with + | (key, _) :: context when is_phrase key -> + phrase_termination context + | _ -> context + +let rec phrase_termination_until keyword context = + match context with + | (key, _) :: context + when is_phrase key && key <> keyword -> + phrase_termination_until keyword context + | _ -> context diff --git a/src/lsp/cobol_indent/indent_util.mli b/src/lsp/cobol_indent/indent_util.mli new file mode 100644 index 000000000..b61e59c22 --- /dev/null +++ b/src/lsp/cobol_indent/indent_util.mli @@ -0,0 +1,44 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Indent_type + +val check_pos: Cobol_common.Srcloc.srcloc -> int -> indent_record list -> bool -> indent_record list + +val failure_msg: Cobol_common.Srcloc.srcloc -> string + +val offset_of_keyword: context_kind -> int + +val offset_of_context: context -> int + +val push_context: context_kind -> context -> context + +val is_data_decl: string -> bool + +val reduce_level: int -> context -> context + +val handle_period: context -> context + +val exp_scope_termination: context_kind -> context -> context + +val pop_until: context_kind -> context -> context + +val pop_until_division: context -> context + +val pop_until_compilation_unit: context -> context + +val imp_scope_termination: context -> context + +val phrase_termination: context -> context + +val phrase_termination_until: context_kind -> context -> context diff --git a/src/lsp/cobol_indent/indenter.ml b/src/lsp/cobol_indent/indenter.ml new file mode 100644 index 000000000..8669ba597 --- /dev/null +++ b/src/lsp/cobol_indent/indenter.ml @@ -0,0 +1,94 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Indent_type + +(* + source_format: source format + str: the string representation of the source Cobol code + rdl: the indentation error information of the source code + range: range of file to indent + result: the Cobol code correctly indented (string) +*) +let indenter ~source_format (str:string) (rdl:indent_record list) range = + let do_one_record (strl:string list) (rd:indent_record) = + let lnum = rd.lnum in + let offset = rd.offset_modif - rd.offset_orig in + let str = List.nth strl (lnum - 1) in + let newstr = + match source_format with + | Cobol_config.SF SFFree -> + if offset > 0 then + let space = String.make offset ' ' in + space^str + else + String.sub str (-offset) (String.length str + offset) + (*TODO: must change if Auto <> SF SFFixed once*) + | SF SFFixed | Auto -> + let len = String.length str in + let str1 = String.sub str 0 7 in + let str = String.sub str 7 (len-7) in + let str = + if offset > 0 then + let space = String.make offset ' ' in + space^str + else + String.sub str (-offset) (String.length str + offset) + in + str1^str + (*TODO*) + | _ -> str + in + List.mapi (fun i str -> if i = lnum - 1 then newstr else str) (strl) + in + let strl = String.split_on_char '\n' str in + let strl = List.fold_left (fun acc rd -> do_one_record acc rd) strl rdl in + let strl = + match range with + | None -> strl + | Some {start_line; end_line} -> + EzList.drop (start_line - 1) @@ EzList.take end_line strl + in + String.concat "\n" strl + +(*indent a range of file, with the default indent_config*) +let indent_range' ~source_format ~range ~file = + let file_content = Ez_file.V1.EzFile.read_file file in + let check_indent = Indent_check.check_indentation in + let state = { + scope = BEGIN; + context = []; + acc = []; + range; + } + in + (* + Not satisfied with the `Cobol_preproc.fold_text_lines`, + this function has an argument which is the name of file, + so when using lsp, every time using the formatting, + we must save the file before, it is not convenient. + *) + let state = + Cobol_preproc.fold_text_lines ~on_period_only:false ~source_format check_indent file state + in + let ind_recds = state.acc in + indenter ~source_format file_content ind_recds state.range + +(*indent a range of file, with the user-defined indent_config*) +let indent_range' ~source_format ~indent_config ~range ~file = + match indent_config with + | Some indent_config -> + Indent_config.set_config ~indent_config; + indent_range' ~source_format ~range ~file + | None -> + indent_range' ~source_format ~range ~file diff --git a/src/lsp/cobol_indent/indenter.mli b/src/lsp/cobol_indent/indenter.mli new file mode 100644 index 000000000..38d3993d7 --- /dev/null +++ b/src/lsp/cobol_indent/indenter.mli @@ -0,0 +1,20 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(*indent a range of file, with the user-defined or default indent_config*) +val indent_range' + : source_format:Cobol_config.source_format_spec + -> indent_config:string option + -> range:Indent_type.range option + -> file:string + -> string diff --git a/src/lsp/cobol_indent/index.mld b/src/lsp/cobol_indent/index.mld new file mode 100644 index 000000000..1ad2895bc --- /dev/null +++ b/src/lsp/cobol_indent/index.mld @@ -0,0 +1,9 @@ +{1 Library cobol_indent} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + + + +The entry point of this library is the module: {!Cobol_indent}. + diff --git a/src/lsp/cobol_indent/package.toml b/src/lsp/cobol_indent/package.toml new file mode 100644 index 000000000..ff44cbb50 --- /dev/null +++ b/src/lsp/cobol_indent/package.toml @@ -0,0 +1,76 @@ + +# name of package +name = "cobol_indent" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +# preprocess = "pps ppx_deriving_encoding" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_common = "version" +cobol_preproc = "version" +fmt = ">=0.9" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/cobol_indent/user_def b/src/lsp/cobol_indent/user_def new file mode 100644 index 000000000..d5188968b --- /dev/null +++ b/src/lsp/cobol_indent/user_def @@ -0,0 +1 @@ +DEFAULT;4 \ No newline at end of file diff --git a/src/vscode-debugadapter/version.mlt b/src/lsp/cobol_indent/version.mlt similarity index 100% rename from src/vscode-debugadapter/version.mlt rename to src/lsp/cobol_indent/version.mlt diff --git a/src/lsp/cobol_lsp/README.md b/src/lsp/cobol_lsp/README.md new file mode 100644 index 000000000..d2566f836 --- /dev/null +++ b/src/lsp/cobol_lsp/README.md @@ -0,0 +1,5 @@ +# Cobol_lsp package + +This package contains all the logic for an LSP server for COBOL. + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_lsp/TODO.md b/src/lsp/cobol_lsp/TODO.md new file mode 100644 index 000000000..cac27abc0 --- /dev/null +++ b/src/lsp/cobol_lsp/TODO.md @@ -0,0 +1,3 @@ +TODO: +* Module `Cobol_lsp.Location` +* `Qualname` visitor diff --git a/src/lsp/cobol_lsp/cobol_lsp.ml b/src/lsp/cobol_lsp/cobol_lsp.ml new file mode 100644 index 000000000..6cb56e92b --- /dev/null +++ b/src/lsp/cobol_lsp/cobol_lsp.ml @@ -0,0 +1,41 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +include Lsp_server_loop + +(* --- *) + +(** {1 Modules and functions exported for testing purposes} + + Signatures of modules below may change unexpectedly. *) + +module INTERNAL = struct + module Types = struct + include Lsp_imports + include Lsp_diagnostics.TYPES + include Lsp_lookup.TYPES + include Lsp_document.TYPES + include Lsp_project.TYPES + include Lsp_project_cache.TYPES + include Lsp_server.TYPES + end + module Diagnostics = Lsp_diagnostics + module Lookup = Lsp_lookup + module Project = Lsp_project + module Project_cache = Lsp_project_cache + module Document = Lsp_document + module Server = Lsp_server + module Loop = Lsp_server_loop + module Request = Lsp_request.INTERNAL + module Utils = Lsp_utils +end diff --git a/src/lsp/cobol_lsp/dune b/src/lsp/cobol_lsp/dune new file mode 100644 index 000000000..97e0418cf --- /dev/null +++ b/src/lsp/cobol_lsp/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_lsp) + (public_name cobol_lsp) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries toml pretty lsp jsonrpc cobol_typeck cobol_parser cobol_indent cobol_data cobol_config cobol_common ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_lsp)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_lsp/index.mld b/src/lsp/cobol_lsp/index.mld new file mode 100644 index 000000000..6d0c5ce02 --- /dev/null +++ b/src/lsp/cobol_lsp/index.mld @@ -0,0 +1,9 @@ +{1 Library cobol_lsp} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package is an LSP server for COBOL. + +The entry point of this library is the module: {!Cobol_lsp}. + diff --git a/src/lsp/cobol_lsp/lsp_completion.ml b/src/lsp/cobol_lsp/lsp_completion.ml new file mode 100644 index 000000000..29794d137 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_completion.ml @@ -0,0 +1,103 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common +open Cobol_common.Basics +(* open Cobol_common.Srcloc.TYPES *) +open Cobol_common.Srcloc.INFIX + +open Lsp_completion_keywords +open Lsp.Types + +let name_proposals ast ~filename pos = + let visitor = object + inherit [StringSet.t] Cobol_parser.PTree_visitor.folder + + method! fold_compilation_unit' cu = + if Lsp_position.is_in_srcloc ~filename pos ~@cu + then Visitor.do_children + else Visitor.skip_children + + method! fold_name name acc = + Visitor.skip_children @@ StringSet.add name acc + + end + in + Cobol_parser.PTree_visitor.fold_compilation_group visitor ast StringSet.empty + |> StringSet.elements + +(*If need be, get the qualname_proposals "X OF Y"... from the definition maps*) + + +(*TODO: If the partial parsing could give more information + like in which statement the position is(or even better, in which clause/phrase), + Then we can remove the keywords that cannot appear in this statement from + the keyword list. +*) +(* type div = +| Ident_div +| Env_div +| Data_div +| Proc_div + +let keyword_proposals ast pos = + let visitor = object + inherit [div option] Cobol_parser.PTree_visitor.folder + + method! fold_data_division' {loc; _} _ = + Visitor.skip_children @@ + if Lsp_position.is_in_srcloc pos loc + then Some Data_div + else None + + method! fold_procedure_division' {loc; _} _ = + Visitor.skip_children @@ + if Lsp_position.is_in_srcloc pos loc + then Some Proc_div + else None + + end + in + match Cobol_parser.PTree_visitor.fold_compilation_group visitor ast None with + | Some Proc_div -> keywords_proc + | Some Data_div -> keywords_data (*does not work*) + | _ -> [] *) + +let keyword_proposals _ast _pos = keywords_all + +let completion_items text (pos:Position.t) ast = + let filename = Lsp.Uri.to_path (Lsp.Text_document.documentUri text) in + let range = + let line = pos.line in + let character = pos.character in + let texts = String.split_on_char '\n' @@ Lsp.Text_document.text text in + let text_line = List.nth texts line in + let index = 1 + String.rindex_from text_line (character - 1) ' ' in + let position_start = Position.create ~character:index ~line in + Range.create ~start:position_start ~end_:pos + in + + let names = name_proposals ast ~filename pos in + let keywords = keyword_proposals ast pos in + let words = names @ keywords in + + List.map (fun x -> + let textedit = TextEdit.create ~newText:x ~range in + (*we may change the ~sortText/preselect for reason of priority *) + CompletionItem.create + ~label:x + ~sortText:x + ~preselect:false + ~textEdit:(`TextEdit textedit) + ()) + words diff --git a/src/lsp/cobol_lsp/lsp_completion_keywords.ml b/src/lsp/cobol_lsp/lsp_completion_keywords.ml new file mode 100644 index 000000000..93744e549 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_completion_keywords.ml @@ -0,0 +1,329 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* open Cobol_common.Basics *) + +let keywords_all = fst @@ List.split Cobol_parser.Text_keywords.keywords + + +(* TODO: Too many keywords, hard to classification *) + +(* let keywords_proc = + let keywords = [ + "ACCEPT"; "ADD"; + "CALL"; "COMPUTE"; + "DELETE"; "DISPLAY"; "DIVIDE"; + "EVALUATE"; + "IF"; + "MULTIPLY"; + "PERFORM"; + "READ"; "RETURN"; "REWRITE"; + "SEARCH"; "START"; "STRING"; "SUBTRACT"; + "UNSTRING"; + "WRITE"; + ] in + (List.map (fun x -> "END-"^x) keywords) @ keywords + + @ [ + "ALLOCATE"; + "CANCEL"; "CLOSE"; "CONTINUE"; + "EXIT"; + "FREE"; + "GO"; "GOBACK"; "GENERATE"; + "INITIALIZE"; "INITIATE"; "INSPECT"; "INVOKE"; + "MERGE"; "MOVE"; + "OPEN"; + "RAISE"; "RELEASE"; "RESUME"; + "SET"; "SORT"; "STOP"; "SUPPRESS"; + "TERMINATE"; + "UNLOCK"; "USE"; + "VALIDATE"; + + "ON SIZE ERROR"; "NOT ON SIZE ERROR"; + "ON EXCEPTION"; "NOT ON EXCEPTION"; + "AT END"; "NOT AT END"; + "INVALID KEY"; "NOT INVALID KEY"; + "AT END OF PAGE"; "NOT AT END OF PAGE"; + "AT EOP"; "NOT AT EOP"; + "ON OVERFLOW"; "NOT ON OVERFLOW"; + "SIZE"; "ERROR"; "INVALIDE"; "KEY"; "EXCEPTION"; "EOP"; "END"; "PAGE"; "OVERFLOW"; + + "SECTION"; "FUNCTION"; "DIRECTIVE"; + + "WHEN"; "ELSE"; + + "WITH"; "IN"; "INTO"; "FROM"; "TO"; "NOT"; "ON"; "BY"; "AT"; "OF"; + "AND"; "ALSO"; "OR"; "IS"; "EQUAL"; + + ] + +(*TODO: (If need) + If the partial parsing could give more information + like in which statement the position is(or even better, in which clause/phrase), + Then we can remove the keywords that cannot appear in this statement from + the keyword list. +*) + +(* let keywords_accept = [ + "ACCEPT"; "FROM"; "LINE NUMBER"; "COL NUMBER"; "COLUMN NUMBER"; + "DATE"; "DAY"; "DAY-OF-WEEK"; "TIME"; "YYYYMMDD"; "YYYYDDD"; + "AT"; "ON EXCEPTION"; "NOT ON EXCEPTION"; "EXCEPTION" + ] *) + +let keywords_proc_other = [ + + (*ACCEPT*) + "DATE"; "DAY"; "DAY-OF-WEEK"; "TIME"; "YYYYMMDD"; "YYYYDDD"; + "LINE"; "NUMBER"; "COL"; "COLUMN"; "CHARACTERS"; + "LINE NUMBER"; "COL NUMBER"; "COLUMN NUMBER"; + + (*ALLOCATE*) + "INITIALIZED"; "RETURNING"; "CHARACTERS"; + + (*CALL*) + "USING BY REFERENCE"; "USING BY CONTENT"; + (* "RETURNING";(*remove duplicate word*) *) + "BY REFERENCE"; "BY CONTENT"; "REFERENCE"; "CONTENT"; "USING"; + + (*CLOSE*) + "REEL"; "UNIT"; + "FOR"; "FOR REMOVAL"; "REMOVAL"; + "WITH NO REWIND"; + "WITH LOCK"; + + (*DELETE*) + "RECORD"; + + (*DISPLAY*) + "UPON"; + (* "LINE"; "NUMBER"; "COL"; "COLUMN"; "CHARACTERS"; + "LINE NUMBER"; "COL NUMBER"; "COLUMN NUMBER"; *) + "WITH NO ADVANCING"; "ADVANCING"; + + (*DIVIDE*) + (* "INTO"; "BY" *) + "GIVING"; + + (*EVALUATE*) + "ALSO"; "OTHER"; + "TRUE"; "FALSE"; "ANY"; + "THROUGH"; "THRU"; + + (*EXIT*) + "PROGRAM"; "METHOD"; "PARAGRAPH"; "CYCLE"; + "LAST EXCEPTION"; "RAISING"; + + (*GO*) + "DEPENDING ON"; "DEPENDING"; + + (*GOBACK*) + (* "RASING"; "EXCEPTION"; + "LAST EXCEPTION"; *) + + (*IF*) + "NEXT SENTENCE"; "NEXT"; "SENTENCE"; "THEN"; + + (*INITIALIZE*) + "WITH FILLER"; "ALL"; "VALUE"; + "THEN REPLACING"; "DATA"; "THEN TO DEFAULT"; + "ALPHABETIC"; "ALPHANUMERIC"; "ALPHANUMERIC-EDITED"; + "BOOLEAN"; "DATA-POINTER"; "FUNCTION-POINTER"; + "NATIONAL"; "NATIONAL-EDITED"; "NUMERIC"; + "NUMERIC-EDITED"; "OBJECT-REFERENCE"; "PROGRAM-POINTER"; + + (*INSPECT*) + "TALLYING"; "REPLACING"; "CONVERTING"; + "LEADING"; "BEFORE"; "AFTER"; "INITIAL"; "BEFORE INITIAL"; "AFTER INITIAL"; + "OMITTED"; "CHARACTERS"; "FIRST"; + + (*INVOKE*) + "USING BY REFERENCE"; + "USING BY CONTENT"; + "USING BY VALUE"; + + (*MERGE*) + "ON ASCENDING KEY"; "ASCENDING KEY"; "ASCENDING"; "KEY"; + "ON DESCENDING KEY"; "DESCENDING KEY"; "DESCENDING"; + "COLLATING SEQUENCE"; + "OUTPUT PROCEDURE"; + "PROCEDURE"; + + (*MOVE*) + "CORR"; "CORRESPONDING"; + + (*OPEN*) + "INPUT"; "OUTPUT"; "I-O"; "EXTEND"; + "SHARING WITH"; + "ALL OTHER"; + "NO OTHER"; + "READ ONLY"; + + (*PERFORM*) + "WITH TEST"; "UNTIL"; "VARYING"; + + (*READ*) + "PREVIOUS"; "PREVIOUS RECORD"; + "ADVANCING ON LOCK"; + (*sharing-phrase*) + "IGNORING LOCK"; + "WITH NO LOCK"; + + (*RESUME*) + "NEXT STATEMENT"; "STATEMENT"; + + (*SET*) + "UP BY"; "DOWN BY"; "OFF"; "ATTRIBUTE"; + "ADDRESS"; "ADDRESS OF"; + "BELL"; "BLINK"; "HIGHLIGHT"; "LOWLIGHT"; "REVERSE-VIDEO"; "UNDERLINE"; + "LOCALE"; "LC_ALL"; "LC_COLLATE"; "LC_CTYPE"; "LC_MESSAGES"; "LC_MONETARY"; + "LC_NUMERIC";"LC_TIME"; "USER-DEFAULT"; "SYSTEM-DEFAULT"; + "CONTENT OF"; "FARTHEST-FROM-ZERO"; "IN-ARITHMETIC-RANGE"; + "FLOAT-INFINITY"; "FLOAT-NOT-A-NUMBER"; + "FLOAT-NOT-A-NUMBER-SIGNALING"; "NEAREST-TO-ZERO"; + "IN-ARITHMETIC-RANGE"; "NEGATIVE"; "POSITIVE"; "SIGN"; + + (*SORT*) + "WITH DUPLICATES IN ORDER"; + "INPUT PROCEDURE IS"; + "OUTPUT PROCEDURE IS"; + + (*START*) + "WITH LENGTH"; + "FIRST"; + "LAST"; + + (*STOP*) + "WITH ERROR STATUS"; + "WITH NORMAL STATUS"; + "STOP RUN"; + + (*STRING*) + "DELIMITED BY"; + + (*SUPPRESS*) + "SUPPRESS PRINTING"; + + (*UNLOCK*) + "RECORDS"; + + (*UNSTRING*) + "DELIMITER IN"; "COUNT IN"; + "TALLYING IN"; + + (*USE*) + "GLOBAL"; + "AFTER STANDARD"; + "BEFORE REPORTING"; + "EC"; "EXCEPTION CONDITION"; + "EO"; "EXCEPTION OBJECT"; + "AFTER STANDARD"; + + (*WRITE*) + "BEFORE ADVANCING"; + "AFTER ADVANCING"; + "ADVANCING"; + "LINES"; + "FILE"; +] + + +let keywords_data = [ + "DATA"; "DIVISION"; "SECTION"; + "WORKING-STORAGE SECTION"; "FILE SECTION"; "REPORT SECTION"; "LOCAL-STORAGE SECTION"; + "LINKAGE SECTION"; "SCREEN SECTION"; "SD"; + + "FD"; "IS"; "EXTERNAL"; "GLOBAL"; "AS"; "FORMAT"; "BIT"; "CHARACTER"; "NUMERIC"; + "BLOCK"; "CONTAINS"; "TO"; "CHARACTERS"; "RECORDS"; "CODE-SET"; "FOR"; "ALPHANUMERIC"; + "NATIONAL"; "REPORT"; "REPORTS"; "ARE"; + + "CONSTANT"; + + "BYTE-LENGTH"; "LENGTH"; "FROM"; + + "RD"; "CODE"; "CONTROL"; "CONTROLS"; "FINAL"; "PAGE"; "LIMIT"; "LIMITS"; + "LINE"; "LINES"; "COLS"; "COLUMNS"; "HEADING"; "FIRST"; "DE"; "DETAIL"; + "LAST"; "CH"; "CONTROL HEADING"; "FOOTING"; + + "USAGE"; "DISPLAY"; "NATIONAL"; "BLANK"; "WHEN"; "PRESENT"; "GROUP"; "OCCURS"; + "DEPENDING ON"; "DEPENDING"; "ON"; "STEP"; + + "REDEFINES"; "TYPEDEF"; "STRONG"; "ALIGNED"; "ANY LENGTH"; "ANY"; "LENGTH"; "BASED"; + "BLANK WHEN ZERO"; "BLANK"; "ZERO"; "RECORD"; "DYNAMIC"; + "GROUP-USAGE"; "GROUP-USAGE IS BIT"; "GROUP-USAGE IS NATIONAL"; + "JUST"; "JUSTIFIED"; "RIGHT"; "JUST RIGHT"; "JUSTIFIED RIGHT"; + "PROPERTY"; "WITH"; "NO"; "SET"; "GET"; "FINAL"; + "SAME AS"; "SIGN"; "LEADING"; "TRAILING"; "SEPARATE"; "SEPARATE CHARACTER"; + "SYNCHRONIZED"; "SYNC"; "LEFT"; "RIGHT"; + "TYPE"; "DESTINATION"; + "INVALID WHEN"; "INVALID"; + "PRESENT WHEN"; "PRESENT"; + "VARYING"; "FROM"; "BY"; + "RENAMES"; "THROUGH"; "THRU"; + + "PLUS"; "MINUS"; "BLANK SCREEN"; "FULL"; "AUTO"; "SECURE"; "REQUIRED"; "TIMES"; + "USAGE IS DISPLAY"; "USAGE IS NATIONAL"; + "BLANK LINE"; "BLANK SCREEN"; + "ERASE"; "END OF LINE"; "END OF SCREEN"; "EOL"; "EOS"; + "BELL"; "HIGHLIGHT"; "LOWLIGHT"; "RESERVED-VIDEO"; "UNDERLINE"; + "FOREGROUND-COLOR"; "BACKGROUND-COLOR"; + "USING"; "VALUE"; + + "CLASS"; "ALPHABETIC"; "ALPHABETIC-LOWER"; "ALPHABETIC-UPPER"; "BOOLEAN"; + + "CODE"; + + "LEFT"; "CENTER"; "RIGHT"; + + "DEFAULT"; "NONE"; + + "FILLER"; + + "FORMAT BIT DATA"; "FORMAT CHARACTER DATA"; "FORMAT NUMERIC DATA"; + + "INDICATE"; + + "LINAGE"; "WITH FOOTING AT"; "LINES AT TOP"; "TOP"; + "LINES AT BOTTOM"; "BOTTOM"; + + "ON NEXT PAGE"; + + "ASCENDING"; "ASCENDING KEY IS"; "DESCENDING"; "DESCENDING KEY IS"; + "INDEXED"; "INDEXED BY"; "STEP"; + + "CAPACITY"; "INITIALIZED"; + + "PIC"; "PICTURE"; "LOCALE"; "SIZE"; "A"; "N"; "X"; "Z"; "1"; "*"; "9"; "+"; "-"; + "CR"; "DB"; "E"; "S"; "V"; "."; "P"; + + "OTHER"; + + "SOURCE"; "SUM"; "UPON"; "RESET"; + + "ON"; "FOR"; "REPORT HEADING"; "RH"; "PAGE HEADING"; "PH"; "CONTROL HEADING"; "CH"; + "CONTROL FOOTING"; "CF"; "PAGE FOOTING"; "PF"; "REPORT FOOTING"; "RF"; + + "BINARY"; "BINARY-CHAR"; "BINARY-SHORT"; "BINARY-LONG"; "BINARY-DOUBLE"; + "COMPUTATIONAL"; "COMP"; "FLOAT-BINARY-32"; "FLOAT-BINARY-64"; + "FLOAT-BINARY-128"; "FLOAT-DECIMAL-16"; "FLOAT-DECIMAL-34"; "FLOAT-EXTENDED"; + "FLOAT-LONG"; "FLOAT-SHORT"; "INDEX"; "OBJECT REFERENCE"; "FACTORY"; + "ACTIVE-CLASS"; "ONLY"; "PACKED-DECIMAL"; "POINTER"; "FUNCTION-POINTER"; + "PROGRAM-POINTER"; "BINARY-ENCODING"; "DECIMAL-ENCODING"; + "HIGH-ORDER-LEFT"; "HIGH-ORDER-RIGHT"; + "VALIDATE-STATUS"; "VAL-STATUS"; "ERROR"; "CONTENT"; "RELATION"; + "VALUES" + ];; + +let keywords_data = StringSet.elements @@ StringSet.of_list keywords_data +let keywords_proc = StringSet.elements @@ StringSet.of_list (keywords_proc @ keywords_proc_other) + *) + diff --git a/src/lsp/cobol_lsp/lsp_diagnostics.ml b/src/lsp/cobol_lsp/lsp_diagnostics.ml new file mode 100644 index 000000000..525d20317 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_diagnostics.ml @@ -0,0 +1,89 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports +open Ez_file.V1 +open EzFile.OP + +module DIAG = Cobol_common.Diagnostics + +module TYPES = struct + type diagnostics = Lsp.Types.Diagnostic.t list URIMap.t +end +include TYPES +type t = diagnostics + +let pseudo_normalized_uri ~rootdir filename = + let filename = + let prefix = EzFile.current_dir_name // "" in + if EzFile.is_absolute filename + then filename + else rootdir // match EzString.chop_prefix ~prefix filename with + | None -> filename + | Some x -> x + in + Lsp.Uri.of_path filename + +let translate_one ~rootdir ~uri (diag: DIAG.t) = + let uri, project_srcloc = match uri with + | `Force uri -> + uri, Cobol_common.Srcloc.lexloc_in ~filename:(Lsp.Uri.to_path uri) + | `Main uri -> + uri, Cobol_common.Srcloc.as_lexloc (* rely on default projection *) + in + let uri, range = + match Option.map project_srcloc (DIAG.location diag) with + | Some (Lexing.{ pos_fname = f; _ }, _ as lexloc) -> + pseudo_normalized_uri ~rootdir f, Lsp_position.range_of_lexloc lexloc + | None -> + uri, Lsp_position.none_range + in + let diag = + Lsp.Types.Diagnostic.create () + ~range + ~severity:(match DIAG.severity diag with + | Hint -> Lsp.Types.DiagnosticSeverity.Hint + | Note | Info -> Information + | Warn -> Warning + | Error -> Error) + ~message:Pretty.(to_string "%t@[%a@]" blast_margin DIAG.pp_msg diag) + in + URIMap.singleton uri [diag] + +let translate ~rootdir ~uri diagnostics = + let init = match uri with `Force uri | `Main uri -> URIMap.singleton uri [] in + DIAG.Set.fold begin fun diagnostic -> + translate_one ~rootdir ~uri diagnostic |> + URIMap.union (fun _uri a b -> Some (List.rev_append a b)) + end diagnostics init + +let publish diagnostics : unit = + URIMap.iter (fun uri diags -> Lsp_io.send_diagnostics ~uri diags) diagnostics + +(* --- *) + +let as_notification ?(log = false) diag = + let type_ = match DIAG.severity diag with + | Hint | Note -> Lsp.Types.MessageType.Log + | Info -> Info + | Warn -> Warning + | Error -> Error + in + let message = + Pretty.(to_string "%t@[%a@]" blast_margin DIAG.pp_msg diag) in + if log then + let params = Lsp.Types.LogMessageParams.create ~message ~type_ in + Lsp.Server_notification.LogMessage params + else + let params = Lsp.Types.ShowMessageParams.create ~message ~type_ in + Lsp.Server_notification.ShowMessage params diff --git a/src/lsp/cobol_lsp/lsp_diagnostics.mli b/src/lsp/cobol_lsp/lsp_diagnostics.mli new file mode 100644 index 000000000..3981352cc --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_diagnostics.mli @@ -0,0 +1,40 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports + +module DIAG = Cobol_common.Diagnostics + +module TYPES: sig + type diagnostics = Lsp.Types.Diagnostic.t list URIMap.t +end +include module type of TYPES + with type diagnostics = TYPES.diagnostics +type t = diagnostics + +val translate_one + : rootdir:string + -> uri:[< `Force of Lsp.Uri.t | `Main of Lsp.Uri.t ] + -> Cobol_common.Diagnostics.t -> diagnostics + +val translate + : rootdir:string + -> uri:[< `Force of Lsp.Uri.t | `Main of Lsp.Uri.t ] + -> Cobol_common.Diagnostics.Set.t -> diagnostics + +val publish + : diagnostics + -> unit + +val as_notification + : ?log:bool -> Cobol_common.Diagnostics.t -> Lsp.Server_notification.t diff --git a/src/lsp/cobol_lsp/lsp_document.ml b/src/lsp/cobol_lsp/lsp_document.ml new file mode 100644 index 000000000..c849b38a4 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_document.ml @@ -0,0 +1,219 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports +open Lsp_lookup.TYPES +open Lsp_project.TYPES +open Ez_file.V1 + +module DIAGS = Cobol_common.Diagnostics + +module TYPES = struct + + type document = + { + project: Lsp_project.t; + textdoc: Lsp.Text_document.t; + copybook: bool; + pplog: Cobol_preproc.rev_log; + tokens: Cobol_parser.tokens_with_locs Lazy.t; + parsed: parsed_data option; + (* Used for caching, when loading a cache file as the file is not reparsed, + then diagnostics are not sent. *) + diags: DIAGS.Set.t; + } + and parsed_data = + { + ast: PTREE.compilation_group; + cus: CUs.t; + (* Extracted info: lazy to only ever retrieve what's relevant upon a first + request. *) + definitions: name_definitions_in_compilation_unit CUMap.t Lazy.t; + references: name_references_in_compilation_unit CUMap.t Lazy.t; + } + + (** Raised by {!retrieve_parsed_data}. *) + exception Unparseable of Lsp.Types.DocumentUri.t + exception Copybook of Lsp.Types.DocumentUri.t + + type cached = (** Persistent representation (for caching) *) + { + doc_cache_filename: string; (* relative to project rootdir *) + doc_cache_checksum: Digest.t; (* checked against file on disk on reload *) + doc_cache_langid: string; + doc_cache_version: int; + doc_cache_pplog: Cobol_preproc.rev_log; + doc_cache_tokens: Cobol_parser.tokens_with_locs; + doc_cache_parsed: (PTREE.compilation_group * CUs.t) option; + doc_cache_diags: DIAGS.Set.serializable; + } + +end +include TYPES + +type t = document +let uri { textdoc; _ } = Lsp.Text_document.documentUri textdoc + +let parse ~project text = + let uri = Lsp.Text_document.documentUri text in + let libpath = Lsp_project.libpath_for ~uri project in + Cobol_parser.parse_with_tokens + (* Recovery policy for the parser: *) + ~recovery:(EnableRecovery { silence_benign_recoveries = true }) + ~source_format:project.source_format + ~config:project.cobol_config + ~libpath + (String { contents = Lsp.Text_document.text text; + filename = Lsp.Uri.to_path uri }) + +let lazy_definitions ast cus = + lazy begin cus |> + CUs.assoc Lsp_lookup.definitions |> + (*this piece for handling renames is temporary*) + Lsp_lookup.add_rename_item_definitions ast |> + Lsp_lookup.add_paragraph_definitions ast |> + Lsp_lookup.add_redefine_definitions ast + end + +let lazy_references ast cus defs = + lazy begin + let defs = Lazy.force defs in + try + List.fold_left + (fun map cu -> + let cu_name = Lsp_lookup.name_of_compunit cu in + let _, cu_defs = CUMap.find_by_name cu_name defs in + CUMap.add + (CUs.find_by_name cu_name cus) + (Lsp_lookup.references cu_defs cu) map ) + CUMap.empty ast + with Not_found -> CUMap.empty + end + +let analyze ({ project; textdoc; copybook; _ } as doc) = + let pplog, tokens, (parsed, diags) = + if copybook then + [], lazy [], (None, DIAGS.Set.none) + else + let ptree = parse ~project textdoc in + Cobol_parser.preproc_rev_log ptree, + Cobol_parser.parsed_tokens ptree, + match Cobol_typeck.analyze_compilation_group ptree with + | Ok (cus, ast, diags) -> + let definitions = lazy_definitions ast cus in + let references = lazy_references ast cus definitions in + Some { ast; cus; definitions; references}, diags + | Error diags -> + None, diags (* NB: no token if unrecoverable error (e.g, wrong + indicator) *) + in + { doc with pplog; tokens; diags; parsed } + +(** Creates a record for a document that is not yet parsed or analyzed. *) +let blank ~project ?copybook textdoc = + let copybook = match copybook with + | Some p -> p + | None -> Lsp_project.detect_copybook project + ~uri:(Lsp.Text_document.documentUri textdoc) + in + { + project; + textdoc; + pplog = []; + tokens = lazy []; + diags = DIAGS.Set.none; + parsed = None; + copybook; + } + +let position_encoding = `UTF8 + +let load ~project ?copybook doc = + Lsp.Text_document.make ~position_encoding doc + |> blank ~project ?copybook + |> analyze + +let update { project; textdoc; _ } changes = + (* TODO: Make it not reparse everything when a change occurs. *) + Lsp.Text_document.apply_content_changes textdoc changes + |> blank ~project + |> analyze + +(** Raises {!Unparseable} in case the document cannot be parsed entierely. *) +let retrieve_parsed_data: document -> parsed_data = function + | { parsed = Some p; _ } -> p + | { copybook = false; _ } as doc -> raise @@ Unparseable (uri doc) + | { copybook = true; _ } as doc -> raise @@ Copybook (uri doc) + +(** Caching utilities *) + +let to_cache ({ project; textdoc; pplog; tokens; parsed; diags; _ } as doc) = + { + doc_cache_filename = Lsp_project.relative_path_for ~uri:(uri doc) project; + doc_cache_checksum = Digest.string (Lsp.Text_document.text textdoc); + doc_cache_langid = Lsp.Text_document.languageId textdoc; + doc_cache_version = Lsp.Text_document.version textdoc; + doc_cache_pplog = pplog; + doc_cache_tokens = Lazy.force tokens; + doc_cache_parsed = Option.map (fun { ast; cus; _ } -> ast, cus) parsed; + doc_cache_diags = DIAGS.Set.apply_delayed_formatting diags; + } + +(* NB: Note this checks against the actual file on disk, which may be different + from what a client sends upon opening. *) +(** Raises {!Failure} in case of bad checksum. *) +let of_cache ~project + { doc_cache_filename = filename; + doc_cache_checksum = checksum; + doc_cache_langid = languageId; + doc_cache_version = version; + doc_cache_pplog = pplog; + doc_cache_tokens = tokens; + doc_cache_parsed = parsed; + doc_cache_diags = diags } = + let absolute_filename = Lsp_project.absolute_path_for ~filename project in + if checksum <> Digest.file absolute_filename then + failwith "Bad checksum" + else + let uri = Lsp.Uri.of_path absolute_filename + and text = EzFile.read_file absolute_filename in + let doc = Lsp.Types.DidOpenTextDocumentParams.create + ~textDocument:(Lsp.Types.TextDocumentItem.create + ~languageId ~text ~uri ~version) in + let doc = Lsp.Text_document.make ~position_encoding doc |> blank ~project in + let parsed = + Option.map + (fun (ast, cus) -> + let definitions = lazy_definitions ast cus in + let references = lazy_references ast cus definitions in + { ast; cus; definitions; references}) + parsed + in + let diags = DIAGS.Set.of_serializable diags in + { doc with pplog; tokens = lazy tokens; parsed; diags } + +(* --- *) + +(** {2 Miscellaneous} *) + +let () = + Printexc.register_printer begin function + | Unparseable uri -> + Some (Pretty.to_string "Unable to parse document at %s" @@ + Lsp.Types.DocumentUri.to_string uri) + | Copybook uri -> + Some (Pretty.to_string "Not parsing copybook at %s" @@ + Lsp.Types.DocumentUri.to_string uri) + | _ -> + None + end diff --git a/src/lsp/cobol_lsp/lsp_imports.ml b/src/lsp/cobol_lsp/lsp_imports.ml new file mode 100644 index 000000000..bcc36d032 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_imports.ml @@ -0,0 +1,24 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Definitions of module aliases and helper functors *) + +module AST = struct + include Cobol_ast (* include general/abstract type definitions, *) + include Cobol_data.Pictured_ast (* and then restricted/refined types. *) +end + +module PTREE = Cobol_parser.PTree +module CUs = Cobol_data.Compilation_unit.SET +module CUMap = Cobol_data.Compilation_unit.MAP +module URIMap = Map.Make (Lsp.Uri) diff --git a/src/lsp/cobol_lsp/lsp_io.ml b/src/lsp/cobol_lsp/lsp_io.ml new file mode 100644 index 000000000..6c13999bb --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_io.ml @@ -0,0 +1,123 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Simple communication functions for the LSP server to send an receive json + RPC messages. *) + +(** [send_out msg] returns {!type:unit} and is used to send out a message. This + function can be edited later to use other channels than stdin or stdout as + IO. *) +let send_out msg = print_string msg + +(** [read_message ()] tries to read a json RPC message from the standard input + stream. Returns [Ok packet] upon success, or [Error error_response] if the + message is in the wrong format. *) +let read_message () : (Jsonrpc.Packet.t, Jsonrpc.Response.Error.t) result = + let rec read_headers acc = + let line = read_line () in + match String.trim line with + | "" -> Ok acc (* an empty line after the headers *) + | line -> + try + let i = String.index line ':' in + if String.get line (i + 1) <> ' ' then raise Not_found; + let header_key = String.lowercase_ascii @@ String.sub line 0 i in + let header_value = + String.lowercase_ascii @@ String.trim @@ + String.sub line (i + 1) (String.length line - i - 1) + in + read_headers @@ (header_key, header_value)::acc + with _ -> Error (Fmt.str "invalid header: %s" line) + in + let rec read_len buf i len = + if len > 0 then + let n = input stdin buf i len in + read_len buf (i + n) (len - n) + in + let headers = read_headers [] in + match headers with + | Ok headers -> + begin match List.assoc_opt "content-type" headers, List.assoc_opt "content-length" headers with + | (Some ("utf8" | "utf-8") | None), Some len_str -> + let content_length = int_of_string_opt len_str in + begin match content_length with + | Some len -> + let buf = Bytes.make len '\000' in + let () = read_len buf 0 len in + let str = Bytes.to_string buf in + begin try + let json = Yojson.Safe.from_string str in + Ok (Jsonrpc.Packet.t_of_yojson json) + with Yojson.Json_error msg -> + let message = Fmt.str "invalid json: %s:\n%s" msg str in + Error (Jsonrpc.Response.Error.(make ~code:Code.ParseError ~message ())) + end + | None -> + let message = Fmt.str "not an integer value: %s" len_str in + Error (Jsonrpc.Response.Error.(make ~code:Code.ParseError ~message ())) + end + | Some _, _ -> + Error + (Jsonrpc.Response.Error.( + make ~code:Code.InvalidRequest ~message:"content-type must be 'utf-8'" ())) + | _, None -> + Error + (Jsonrpc.Response.Error.( + make ~code:Code.ParseError ~message:"missing content-length header" ())) + end + | Error message -> + Error + (Jsonrpc.Response.Error.(make ~code:Code.ParseError ~message ())) + +(** [send_json json] sends out a json rpc package. *) +let send_json json = + let str = Yojson.Safe.to_string json in + let len = String.length str in + let msg = Fmt.str "Content-Length: %d\r\n\r\n%s" len str in + send_out msg + +(** [send_response response] sends out a json RPC response on standard + output. *) +let send_response response = + let json = Jsonrpc.Response.yojson_of_t response in + send_json json + +(** [send_notification notif] sends out a json RPC notification on standard + output. *) +let send_notification notif = + let json = Jsonrpc.Notification.yojson_of_t notif in + send_json json + +(** [send_diagnostics ~uri diagnostics] sends out a list of diagnostics that + pertain to the given URI. *) +let send_diagnostics ~uri diagnostics = + let params = Lsp.Types.PublishDiagnosticsParams.create ~diagnostics ~uri () in + let notif = Lsp.Server_notification.PublishDiagnostics params in + send_notification (Lsp.Server_notification.to_jsonrpc notif) + +(** [pretty_notification ~log ~type_ fmt ...] formats any number of arguments + according to the format string [fmt], and sends the result via a json RPC + notification for log or direct display (depending on the flag [log], false + by default). Also prints the result on stderr (for now). *) +let pretty_notification ?(log = false) ~type_ fmt = + Pretty.string_to begin fun message -> + Pretty.error "Notif: %s@." message; + let notif = + if log + then Lsp.(Server_notification.LogMessage + (Types.LogMessageParams.create ~message ~type_)) + else Lsp.(Server_notification.ShowMessage + (Types.ShowMessageParams.create ~message ~type_)) + in + send_notification (Lsp.Server_notification.to_jsonrpc notif) + end ("%t@["^^fmt^^"@]") Pretty.blast_margin diff --git a/src/lsp/cobol_lsp/lsp_io.mli b/src/lsp/cobol_lsp/lsp_io.mli new file mode 100644 index 000000000..d21a2d414 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_io.mli @@ -0,0 +1,39 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Simple communication functions for the LSP server to send an receive json + RPC messages. *) + +(** [read_message ()] tries to read a json RPC message from the standard input + stream. *) +val read_message: unit -> (Jsonrpc.Packet.t, Jsonrpc.Response.Error.t) result + +(** [send_response response] sends out a json RPC response on standard + output. *) +val send_response: Jsonrpc.Response.t -> unit + +(** [send_notification notif] sends out a json RPC notification on standard + output. *) +val send_notification: Jsonrpc.Notification.t -> unit + +(** [send_diagnostics ~uri diagnostics] sends out a list of diagnostics that + pertain to the given URI. *) +val send_diagnostics: uri:Lsp.Uri.t -> Lsp.Types.Diagnostic.t list -> unit + +(** [pretty_notification ~log ~type_ fmt ...] formats any number of arguments + according to the format string [fmt], and sends the result via a json RPC + notification. Also prints the result on stderr (for now). *) +val pretty_notification + : ?log:bool + -> type_:Lsp.Types.MessageType.t + -> ('a, Format.formatter, unit) format -> 'a diff --git a/src/lsp/cobol_lsp/lsp_lookup.ml b/src/lsp/cobol_lsp/lsp_lookup.ml new file mode 100644 index 000000000..cb363d148 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_lookup.ml @@ -0,0 +1,523 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common (* Srcloc, Visitor *) +open Cobol_common.Srcloc.INFIX +open Cobol_data.Types +open Lsp_imports + +module TYPES = struct + + (** Type definitions to help representing and querying (partially) parsed + COBOL programs. *) + + open Cobol_common.Srcloc (* with_loc & pp_with_loc *) + + (** Information returned by {!names_at_position}. *) + type names_at_position = + { + qualname_at_position: AST.qualname option; + enclosing_compilation_unit_name: string option; + } + + type name_definition = + { + as_paragraph: paragraph_definition option; (* link to AST's paragraph *) + as_item: item_definition option; + } [@@deriving show] + and paragraph_definition = + AST.paragraph with_loc [@@deriving show] + and item_definition = + { + item_definition: AST.any_item_descr with_loc; + item_redefinitions: AST.name with_loc list; + } [@@deriving show] + + type name_definitions_in_compilation_unit = + name_definition Cobol_data.Qualmap.t [@@deriving show] + + type name_references_in_compilation_unit = + Srcloc.srcloc list Cobol_data.Qualmap.t [@@deriving show] + + type copy_operation = string with_loc (** with loc of {[COPY ...]} *) + +end +open TYPES + +(* --- *) + +let bare name : AST.qualname = AST.Name name +let qual name : AST.qualname option -> AST.qualname = function + | None -> AST.Name name + | Some qn -> AST.Qual (name, qn) +let simple_name : AST.qualname -> string = function + | Qual (n, _) | Name n -> ~&n +let baseloc_of_qualname: AST.qualname -> srcloc = function + | Name name + | Qual (name, _) -> ~@name + +(* TODO: manipulate positions that are combined with a filename instead of + passing `filename` around all the time. *) + +(** [lexloc_of_qualname_in ~filename qualname] returns the full location of + [qualname], from the first qualifier to the last. This function is + temporary and is expected to be replaced once a better way of getting this + location is found. *) +let lexloc_of_qualname_in ~filename (qn: AST.qualname) = + let rec end_pos: AST.qualname -> Lexing.position = function + | Name n -> Cobol_common.Srcloc.end_pos_in ~filename ~@n + | Qual (_, qn) -> end_pos qn + in + match qn with + | Name n -> Cobol_common.Srcloc.lexloc_in ~filename ~@n + | Qual (n, qn) -> Cobol_common.Srcloc.start_pos_in ~filename ~@n, end_pos qn + +(** [qualname_at_pos ~filename qualname pos] returns the qualname built from all + the qualifiers of [qualname] that are after or at position [pos] ion + [filename]. This function is temporary and is expected to be replaced once + a better way of finding the qualname is implemented. *) +let rec qualname_at_pos ~filename (qn: AST.qualname) pos = + match qn with + | Name _ -> + qn + | Qual (name, qn') -> + let lexloc = lexloc_of_qualname_in ~filename qn in + if not (Lsp_position.is_after_lexloc pos lexloc) && + not (Lsp_position.is_in_srcloc ~filename pos ~@name) + then qualname_at_pos ~filename qn' pos + else qn + +let name_of_compunit (cu: PTREE.compilation_unit with_loc) = + match ~&cu with + | Program {program_name = name; _} + | Function {function_name = name; _} + | ClassDefinition {class_name = name; _} + | InterfaceDefinition {interface_name = name; _} -> ~&name + +let compilation_unit_by_name (cu_name: AST.name) (ptree: PTREE.compilation_group) = + List.find_opt (fun cu -> cu_name = name_of_compunit cu) ptree + +(* --- *) + +(** [names_at_position pos ptree] seeks the compilation unit name and qualified + name at the given position [pos], in compilation group parse-tree + [ptree]. *) +let names_at_position ~uri pos ptree : names_at_position = + let filename = Lsp.Uri.to_path uri in + let open struct + + type acc = + { + names: names_at_position; + qualifiers: (AST.qualname * int) list; (* qualifiers stack *) + qualifiers_for_redef: (AST.qualname * int) list;(* all qualnames can be redefined*) + } + + let init = + { + names = { qualname_at_position = None; + enclosing_compilation_unit_name = None }; + qualifiers = []; + qualifiers_for_redef = []; + } + + let result acc = acc.names + + let qualify n = function + | [] -> bare n + | (qn, _) :: _ -> qual n (Some qn) + + let rec pop_qualifiers l = function + | [] -> [] + | (_, l') :: tl when l <= l' -> pop_qualifiers l tl + | l -> l + + let push_qualifier n l qualifiers = + let qn = qualify n qualifiers in + qn, (qn, l) :: qualifiers + + let update_qualifiers n l qualifiers = + push_qualifier n l @@ pop_qualifiers l qualifiers + + let reset_qualifiers acc = {acc with qualifiers = []} + + end in + + let srcloc_contains pos loc = + Lsp_position.is_in_srcloc ~filename pos loc + in + + let on_name n loc ({ names; qualifiers; _ } as acc) = + Visitor.do_children @@ + if srcloc_contains pos loc + then { acc with + names = { names with + qualname_at_position = Some (qualify n qualifiers) } } + else acc + in + + let on_item n l loc { names; qualifiers; qualifiers_for_redef } = + Visitor.do_children @@ + let qn, qualifiers = update_qualifiers n l qualifiers in + let qualifiers_for_redef = (qn, l) :: pop_qualifiers (l + 1) qualifiers_for_redef in + { names = + if srcloc_contains pos loc + then { names with qualname_at_position = Some qn } + else names; + qualifiers; qualifiers_for_redef} + in + + let on_filler l ({qualifiers; qualifiers_for_redef; _} as acc) = + Visitor.do_children @@ + let qualifiers_for_redef = pop_qualifiers (l + 1) qualifiers_for_redef in + let qualifiers = pop_qualifiers l qualifiers in + { acc with qualifiers_for_redef; qualifiers} + in + + let on_group_item name level loc acc = + match name with + | _ when acc.names.qualname_at_position <> None -> + Visitor.skip_children acc + | Some { payload = AST.DataFiller; _ } | None -> + on_filler level acc + | Some { payload = DataName name; _ } -> + on_item name level loc acc + in + + Cobol_parser.PTree_visitor.fold_compilation_group (object + inherit [acc] Cobol_parser.PTree_visitor.folder + inherit! [acc] Lsp_position.sieve ~filename ~pos + + method! fold_compilation_unit' cu ({ names; _ } as acc) = + if Lsp_position.is_in_srcloc ~filename pos ~@cu then + let cu_name = name_of_compunit cu in + let names = { names with + enclosing_compilation_unit_name = Some cu_name } in + Visitor.do_children { acc with names } + else + Visitor.skip_children acc + + method! fold_qualname qn ({ names; _ } as acc) = + if Lsp_position.is_in_lexloc pos (lexloc_of_qualname_in ~filename qn) then + let qn = qualname_at_pos ~filename qn pos in + let names = { names with qualname_at_position = Some qn } in + Visitor.skip_children { acc with names } + else + Visitor.skip_children acc + + (* Note: we bypass the sieve on the following items, and re-implement (sic) + the name qualification mechanism in sections of the DATA DIVISION. *) + + (* TODO: check whether it is worth resetting the qualifiers stack when + entering the relevant sections. *) + + method! fold_data_clause clause ({qualifiers_for_redef; names; _} as acc) = + Visitor.skip_children @@ match clause with + | DataRedefines name when srcloc_contains pos ~@name -> + let x = List.find_opt + (fun (qn, _) -> + simple_name qn = ~&name) + qualifiers_for_redef + in + begin match x with + | None -> acc + | Some (qn, _) -> + {acc with names = {names with qualname_at_position = Some qn }} + end + | _ -> acc + + method! fold_data_item' { loc; payload = { data_level = l; + data_name = n; _ } } = + on_group_item n ~&l loc + + method! fold_screen_item' { loc; payload = { screen_level = l; + screen_data_name = n; _ } } = + on_group_item n l loc + + method! fold_report_group_item' { loc; + payload = { report_level = l; + report_data_name = n; _ } } = + on_group_item n l loc + + method! fold_constant_item' { loc; payload = { constant_level = l; (* 01 *) + constant_name = n; _ } } acc = + on_group_item n ~&l loc (reset_qualifiers acc) (* CHECKME: should reset qualifiers... *) + + method! fold_rename_item' { loc; payload = { rename_to; _ } } acc = + (*rename_item can only be qualified by the data-name of level 01 + ISO/IEC 1989:2014 P379 13.18.45.2(3) *) + on_name rename_to loc {acc with qualifiers = pop_qualifiers 01 acc.qualifiers} + + method! fold_condition_name_item' { loc; payload = { condition_name; _ } } = + on_name condition_name loc + + end) ptree init |> result + +(* --- *) + +(** Name definitions retrieval *) + +let def_binding qn map = + (* TODO: Qualmap.update? *) + try Cobol_data.Qualmap.find qn map + with Not_found -> { as_paragraph = None; as_item = None } + +let def_paragraph qn para map = + let binding = def_binding qn map in + Cobol_data.Qualmap.add qn { binding with as_paragraph = Some para } map + +let def_item qn item map = + let binding = def_binding qn map in + Cobol_data.Qualmap.add qn { binding with as_item = Some item } map + +let def_redefinition qn redefine_item map = + let binding = def_binding qn map in + match binding.as_item with + | None -> + map (* ignore binding *) + | Some ({ item_redefinitions = redefs; _ } as item) -> + def_item qn { item with item_redefinitions = redefine_item :: redefs } map + + +(** Creates a mapping of item definitions from a type-checked group item. *) +(*TODO: Make it with QualName so we have better definition finding *) +let definitions: compilation_unit -> name_definitions_in_compilation_unit = + let rec def_group ?cur_qn map { loc; payload = group } = + let group_infos = match group with + | Cobol_data.Group.Elementary { name; data_item = Data item; _ } -> + Some (name, AST.Data item, []) + | Constant { name; constant_item_descr = Constant c; _ } -> + Some (name, Constant c, []) + | Group { name; data_item = Data item; elements = children; _ } -> + Some (name, Data item, children) + | Renames _ (* TODO (needs _ item_descr) *) + | ConditionName _ -> (* TODO: ditto*) + None + in + match group_infos with + | Some (group_name, item_definition, children) -> + (* TODO: group_name: `string with_loc` instead of just `string` *) + let qn = qual (group_name &@ loc) cur_qn in + let map = def_item qn { item_definition = item_definition &@ loc; + item_redefinitions = [] } map in + List.fold_left (def_group ~cur_qn:qn) map children + | None -> (* ignore *) + map + in + + fun { cu_wss; _ } -> + List.fold_left def_group Cobol_data.Qualmap.empty cu_wss + + +let update_definitions_based_on_compilation_group_ptree ~f ptree defs = + let cus = CUMap.compilation_units defs in + List.fold_left begin fun defs cu' -> + try + let cu = CUs.find_by_name (name_of_compunit cu') cus in + CUMap.update cu begin fun cu_defs -> + Some (f cu' @@ Option.value cu_defs ~default:Cobol_data.Qualmap.empty) + end defs + with Not_found -> defs + end defs ptree + + +(*TODO: remove this once Cobol_typeck implements Renames*) +let add_rename_item_definitions ptree defs = +(*rename_item can only be qualified by the data-name of level 01 + ISO/IEC 1989:2014 P379 13.18.45.2(3) *) + let visitor = object + inherit [name_definitions_in_compilation_unit * + AST.qualname option] Cobol_parser.PTree_visitor.folder + + method! fold_data_item { data_level; data_name; _ } ((map, _) as acc) = + Visitor.do_children @@ + match data_name with + | Some { payload = DataFiller; _ } | None when ~&data_level = 1 -> + map, None + | Some { payload = DataName name; _ } when ~&data_level = 1 -> + map, Some (bare name) + | _ -> + acc + + method! fold_rename_item' { payload = { rename_to = name; _ } as rename; + loc } (map, cur_qn) = + Visitor.skip_children @@ + (def_item (qual name cur_qn) + { item_definition = AST.Renames rename &@ loc; + item_redefinitions = [] } map, + cur_qn) + end in + + update_definitions_based_on_compilation_group_ptree ptree defs + ~f:begin fun cu' defs -> + Cobol_parser.PTree_visitor.fold_compilation_unit' visitor + cu' (defs, None) |> fst + end + + +let add_paragraph_definitions ptree defs = + + let register_section name s (defs, _section_name) = + let qn = bare name in + Visitor.do_children (def_paragraph qn s defs, Some qn) + + and register_paragraph name p (defs, section_name) = + let qn = qual name section_name in + Visitor.do_children (def_paragraph qn p defs, section_name) + in + + let visitor = object + inherit [name_definitions_in_compilation_unit * + AST.qualname option] Cobol_parser.PTree_visitor.folder + + method! fold_environment_division _ = Visitor.skip + method! fold_data_division' _ = Visitor.skip + + method! fold_paragraph' p = match ~&p with + | { paragraph_name = None; _ } -> Visitor.skip_children + | { paragraph_is_section = true; + paragraph_name = Some name; _ } -> register_section name p + | { paragraph_name = Some name; _ } -> register_paragraph name p + + end in + update_definitions_based_on_compilation_group_ptree ptree defs + ~f:begin fun cu' defs -> + Cobol_parser.PTree_visitor.fold_compilation_unit' visitor + cu' (defs, None) |> fst + end + + +let add_redefine_definitions ptree defs = + let open struct + type acc = + { + defs: name_definitions_in_compilation_unit; + qualifiers: (AST.qualname * int) list; (* qualifiers stack *) + aux: (AST.qualname * int) list; (* all qualnames can be redefined*) + } + + let qualify n = function + | [] -> bare n + | (qn, _) :: _ -> qual n (Some qn) + + let rec pop_qualifiers l = function + | [] -> [] + | (_, l') :: tl when l <= l' -> pop_qualifiers l tl + | l -> l + + let push_qualifier n l qualifiers = + let qn = qualify n qualifiers in + qn, (qn, l) :: qualifiers + + let update_qualifiers n l qualifiers = + push_qualifier n l @@ pop_qualifiers l qualifiers + + let result acc = acc.defs + + end in + + let visitor = object + inherit [acc] Cobol_parser.PTree_visitor.folder + + method! fold_environment_division _ = Visitor.skip + method! fold_procedure_division _ = Visitor.skip + + method! fold_data_item {data_level; data_name; _} ({qualifiers; aux; _} as acc) = + let l = ~&data_level in + match data_name with + | Some { payload = AST.DataFiller; _ } | None -> + Visitor.do_children @@ + let aux = pop_qualifiers (l + 1) aux in + let qualifiers = pop_qualifiers l qualifiers in + { acc with aux; qualifiers} + | Some { payload = DataName name; _ } -> + Visitor.do_children @@ + let qn, qualifiers = update_qualifiers name l qualifiers in + let aux = (qn, l) :: pop_qualifiers (l + 1) aux in + { acc with qualifiers; aux} + + method! fold_data_clause clause ({defs; aux; _} as acc) = + Visitor.skip_children @@ match clause with + | DataRedefines name -> + let x = List.find_opt + (fun (qn, _) -> + simple_name qn = ~&name) + aux + in + begin match x with + | None -> acc + | Some (qn, _) -> + {acc with defs = def_redefinition qn name defs} + end + | _ -> acc + + end in + update_definitions_based_on_compilation_group_ptree ptree defs + ~f:begin fun cu' defs -> + Cobol_parser.PTree_visitor.fold_compilation_unit' visitor + cu' {defs; aux = []; qualifiers = []} |> result + end + + +let references_of_qualname qn cu cu_defs = + + let visitor key = object + (*[key] is the full qualname of the data*) + inherit [srcloc list] Cobol_parser.PTree_visitor.folder + method! fold_environment_division _ = Visitor.skip + method! fold_qualname qn locs = + match Cobol_data.Qualmap.find_full_qualname_opt qn cu_defs with + | Some full_qn when AST.compare_qualname full_qn key = 0 -> + Visitor.skip_children @@ baseloc_of_qualname qn :: locs + | Some _ -> + Visitor.do_children locs + | None -> + Visitor.skip_children locs + end in + + let qn = match Cobol_data.Qualmap.find_full_qualname_opt qn cu_defs with + | Some qn -> qn + | None -> qn + in + let refs_in_data_div_or_proc_div = + Cobol_parser.PTree_visitor.fold_compilation_unit' + (visitor qn) cu [] + and refs_in_redef_clauses = (* redefinitions *) + match Cobol_data.Qualmap.find qn cu_defs with + | { as_item = Some { item_redefinitions = redefs; _ }; _ } -> + List.rev_map (~@) redefs + | _ -> [] + | exception Not_found -> [] + in + refs_in_redef_clauses @ List.rev refs_in_data_div_or_proc_div + +let references cu_defs cu = + Cobol_data.Qualmap.fold + (fun qn _ map -> + Cobol_data.Qualmap.add qn (references_of_qualname qn cu cu_defs) map) + cu_defs Cobol_data.Qualmap.empty + +let copy_at_pos ~filename pos ptree = + Cobol_parser.PTree_visitor.fold_compilation_group (object + inherit [copy_operation option] Cobol_parser.PTree_visitor.folder + method! fold' { loc; _ } = function + | Some _ as acc -> + Visitor.skip_children acc + | None -> + match Srcloc.as_copy loc with + | Some { loc; _ } as copy + when Lsp_position.is_in_srcloc ~filename pos loc -> + Visitor.skip_children copy + | _ -> + Visitor.do_children None + end) ptree None diff --git a/src/lsp/cobol_lsp/lsp_notif.ml b/src/lsp/cobol_lsp/lsp_notif.ml new file mode 100644 index 000000000..2ae01984d --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_notif.ml @@ -0,0 +1,42 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_server.TYPES + +let on_notification state notif = + match state, notif with + | ShuttingDown, Lsp.Client_notification.Exit -> + Exit (Ok ()) + | ShuttingDown, _ -> + ShuttingDown + | NotInitialized _ | Exit _ as state, _ -> + state (* spec indicate notif should just be discarded *) + | Initialized config, Initialized -> + Running (Lsp_server.init ~config) + | Running registry, TextDocumentDidOpen params -> + Running (Lsp_server.add params registry) + | Running registry, TextDocumentDidChange params -> + Running (Lsp_server.update params registry) + | Running registry, TextDocumentDidClose params -> + Running (Lsp_server.remove params registry) + | Running _, Exit -> + Exit (Error "Received premature 'exit' notification") + | _ -> + state + +let handle notif status = + match Lsp.Client_notification.of_jsonrpc notif with + | Error str -> + Pretty.failwith "LSP@ sever@ could@ not@ decode@ notification:@ %s" str + | Ok notif -> + on_notification status notif diff --git a/src/lsp/cobol_lsp/lsp_notif.mli b/src/lsp/cobol_lsp/lsp_notif.mli new file mode 100644 index 000000000..3a3b4c299 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_notif.mli @@ -0,0 +1,14 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val handle: Jsonrpc.Notification.t -> (Lsp_server.state as 's) -> 's diff --git a/src/lsp/cobol_lsp/lsp_position.ml b/src/lsp/cobol_lsp/lsp_position.ml new file mode 100644 index 000000000..c587ee140 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_position.ml @@ -0,0 +1,82 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module has utility functions to use {!Lsp.Types.Position} and + {!Lsp.Types.Range} types with {!Srcloc.lexloc} and {!Srcloc.srcloc}. *) + +open Cobol_common +open Srcloc.TYPES +open Lsp.Types + +(** Range of length [0], at position [0, 0] *) +let none_range = + let none_pos = Position.create ~line:0 ~character:0 in + Range.create ~start:none_pos ~end_:none_pos + +(** {1 Postions {i w.r.t} lexical locations} *) + +(** [range_of_lexloc] creates a representation of the given lexical location + that is suitable for the LSP library. *) +let range_of_lexloc ((start_pos, end_pos): lexloc) = + (* NOTE: Line numbers start at 0 in LSP protocol. *) + let sl = start_pos.pos_lnum - 1 + and sc = start_pos.pos_cnum - start_pos.pos_bol + and el = end_pos.pos_lnum - 1 + and ec = end_pos.pos_cnum - end_pos.pos_bol in + Range.create + ~start:(Position.create ~line:sl ~character:sc) + ~end_:(Position.create ~line:el ~character:ec) + +(** [is_before_lexloc pos lexloc] holds when [pos] is strictly before [lexloc] *) +let is_before_lexloc pos lexloc = + let Range.{start = {line; character;}; _} = range_of_lexloc lexloc in + Position.(pos.line < line || (pos.line = line && pos.character < character)) + +(** [is_after_lexloc pos lexloc] holds when [pos] is strictly after [lexloc] *) +let is_after_lexloc pos lexloc = + let Range.{end_ = {line; character;}; _} = range_of_lexloc lexloc in + Position.(pos.line > line || (pos.line = line && pos.character > character)) + +(** [is_in_lexloc pos lexloc] holds when [pos] is neither before or after + [lexloc] *) +let is_in_lexloc pos lexloc = + (not @@ is_after_lexloc pos lexloc) && (not @@ is_before_lexloc pos lexloc) + +(** [contains_lexloc range lexloc] holds when [lexloc] is strictly contained + inside [range]. *) +let contains_lexloc Range.{start; end_} lexloc = + is_before_lexloc start lexloc && is_after_lexloc end_ lexloc + +(* --- *) + +(** {1 Postions {i w.r.t} generalized source locations} *) + +(** [range_of_srcloc_in ~filename srcloc] is [range_of_srcloc (Srcloc.lexloc_in + ~filename srcloc)] *) +let range_of_srcloc_in ~filename srcloc = + range_of_lexloc (Srcloc.lexloc_in ~filename srcloc) + +(** [is_in_srcloc ~filename pos srcloc] is a shorthand for [is_in_lexloc pos + (Srcloc.lexloc_in ~filename srcloc)] *) +let is_in_srcloc ~filename pos srcloc = + is_in_lexloc pos (Srcloc.lexloc_in ~filename srcloc) + +(* --- *) + +class ['x] sieve ~filename ~pos = object + method fold': 'n. ('n with_loc, 'x) Cobol_common.Visitor.fold = + fun { loc; _ } -> + if is_in_srcloc ~filename pos loc + then Visitor.do_children + else Visitor.skip_children +end diff --git a/src/lsp/cobol_lsp/lsp_position.mli b/src/lsp/cobol_lsp/lsp_position.mli new file mode 100644 index 000000000..9996a587c --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_position.mli @@ -0,0 +1,61 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module has utility functions to use {!Lsp.Types.Position} and + {!Lsp.Types.Range} types with {!Srcloc.lexloc} and {!Srcloc.srcloc}. *) + +(** Range of length [0], at position [0, 0] *) +val none_range: Lsp.Types.Range.t + +(** [range_of_lexloc] creates a representation of the given lexical location + that is suitable for the LSP library. *) +val range_of_lexloc: Cobol_common.Srcloc.lexloc -> Lsp.Types.Range.t + +(** [is_before_lexloc pos lexloc] holds when [pos] is strictly before + [lexloc] *) +val is_before_lexloc: Lsp.Types.Position.t -> Cobol_common.Srcloc.lexloc -> bool + +(** [is_after_lexloc pos lexloc] holds when [pos] is strictly after [lexloc] *) +val is_after_lexloc: Lsp.Types.Position.t -> Cobol_common.Srcloc.lexloc -> bool + +(** [is_in_lexloc pos lexloc] holds when [pos] is neither before or after + [lexloc] *) +val is_in_lexloc: Lsp.Types.Position.t -> Cobol_common.Srcloc.lexloc -> bool + +(** [contains_lexloc range lexloc] holds when [lexloc] is strictly contained + within [range]. *) +val contains_lexloc: Lsp.Types.Range.t -> Cobol_common.Srcloc.lexloc -> bool + +(* --- *) + +val range_of_srcloc_in + : filename:string + -> Cobol_common.Srcloc.srcloc + -> Lsp.Types.Range.t + +val is_in_srcloc + : filename:string + -> Lsp.Types.Position.t + -> Cobol_common.Srcloc.srcloc + -> bool + +(* --- *) + +(** [sieve ~filename ~pos] is a folder visitor that skips any localized AST node + whose source location does not include the given position. To be used as a + mixin component so it overrides [fold'] last. *) +class ['x] sieve: filename:string -> pos:Lsp.Types.Position.t -> + object + method fold' + : 'n. ('n Cobol_common.Srcloc.with_loc, 'x) Cobol_common.Visitor.fold + end diff --git a/src/lsp/cobol_lsp/lsp_project.ml b/src/lsp/cobol_lsp/lsp_project.ml new file mode 100644 index 000000000..577c88f7c --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_project.ml @@ -0,0 +1,322 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** This module contains the functions to parse and get the configuration *) + +open Ez_file.V1 +open EzFile.OP +open Toml.Types + +module DIAGS = Cobol_common.Diagnostics + +module TABLE = + Ephemeron.K1.Make (struct + include String (* rootdir *) + let hash = Hashtbl.hash + end) + +module TYPES = struct + + type path = + | RelativeToProjectRoot of string + | RelativeToFileDir of string + + type rootdir = string (* private *) + + type project = { (* private *) + rootdir: rootdir; + config_checksum: Digest.t option; + cobol_config: Cobol_config.t; + source_format: Cobol_config.source_format_spec; + libpath: path list; + copybook_extensions: string list; + copybook_if_no_extension: bool; + } + + type layout = { + project_config_filename: string; + } + +end +include TYPES +type t = project + +let rootdir { rootdir; _ } = rootdir +let string_of_rootdir = Fun.id + +type cached = { (** Persistent representation (for caching) *) + cached_config_checksum: Digest.t option; + cached_cobol_config: Cobol_config.t; + cached_source_format: Cobol_config.source_format_spec; + cached_libpath: path list; + cached_copybook_extensions: string list; + cached_copybook_if_no_extensions: bool; +} + +module M = struct + type nonrec t = t + let compare { rootdir = d1; _ } { rootdir = d2; _ } = String.compare d1 d2 +end + +module SET = struct + include Set.Make (M) + let for_rootdir ~rootdir s = + let p = find_first (fun p -> String.compare p.rootdir rootdir >= 0) s in + if p.rootdir = rootdir then p else raise Not_found + let mem_rootdir ~rootdir s = + try ignore (for_rootdir ~rootdir s); true with Not_found -> false +end + +module MAP = Map.Make (M) + +let rootdir_for ~uri ~layout:{ project_config_filename; _ } = + let rec try_dir dir = + if EzFile.exists (dir // project_config_filename) + then Some dir + else + let new_dir = EzFile.dirname dir in + if new_dir = dir + then None (* we are at root *) + else try_dir new_dir + in + let filename = Lsp.Uri.to_path uri in + let dir = match try_dir (EzFile.dirname filename) with + | Some dir -> dir + | None -> EzFile.dirname filename + in + (* Pretty.error "Project directory: %s@." dir; *) + dir + +let config_from_dialect_name ?(strict = false) dialect = + try + let dialect = Cobol_config.DIALECT.of_string dialect in + Cobol_common.catch_diagnostics + (fun diags dialect -> + Ok (Cobol_config.from_dialect diags ~strict dialect, + DIAGS.Set.none)) + dialect + with Invalid_argument e -> + Error (DIAGS.Set.error "Unknown dialect: %s" e) + +let default_libpath = [RelativeToProjectRoot "."] +let default_copybook_extensions = Cobol_preproc.Copybook.copybook_extensions +let default_copybook_if_no_extension = true + +let default ~rootdir = { + rootdir; + config_checksum = None; + cobol_config = Cobol_config.default; + source_format = Cobol_config.(SF SFFixed); + libpath = default_libpath; + copybook_extensions = default_copybook_extensions; + copybook_if_no_extension = default_copybook_if_no_extension; +} + +let dialect_key = Table.Key.of_string "dialect" +and source_format_key = Table.Key.of_string "source-format" +and strict_key = Table.Key.of_string "strict" +and dir_key = Table.Key.of_string "dir" +and file_relative_key = Table.Key.of_string "file-relative" +and copybook_key = Table.Key.of_string "copybook" + +let expected acc ~kind ~key = + DIAGS.Acc.error acc + "Invalid@ entry@ type@ for@ key@ `%s',@ %s@ expected" + (Table.Key.to_string key) kind +let expected_string = expected ~kind:"string" +let expected_bool = expected ~kind:"Boolean" + +(** [read_config_file file] returns the project configuration from the file + [file]. Errors and warnings raised when parsing this file are directly + publised via {!Lsp_io}. *) +let read_config_file ~rootdir config_file = + let copybook_entries table = + List.fold_left begin fun (libpath, errors) entry -> + match Table.find_opt dir_key entry, + Table.find_opt file_relative_key entry with + | Some TString str, Some TBool true -> + RelativeToFileDir str :: libpath, errors + | Some TString str, (None | Some TBool false) -> + RelativeToProjectRoot str :: libpath, errors + | Some TString _, Some _ -> + libpath, expected_bool ~key:file_relative_key errors + | Some _, _ -> + libpath, expected_string ~key:dir_key errors + | None, _ -> + libpath, errors + end (default_libpath, DIAGS.Set.none) table + in + (* TODO: push notifications directly via {!Lsp_io.pretty_notification} *) + let config, diags = match Toml.Parser.from_filename config_file with + | `Ok toml -> + let config = + match Table.find_opt dialect_key toml, + Table.find_opt strict_key toml with + | Some TString dialect, Some TBool strict -> + config_from_dialect_name dialect ~strict + | Some TString dialect, None -> + config_from_dialect_name dialect + | None, (None | Some TBool _) -> (* match on strict so it is not caught + in last case *) + Ok (Cobol_config.default, DIAGS.Set.none) + | Some _, _ -> + Error (expected_string ~key:dialect_key DIAGS.Set.none) + | _, Some _ -> + Error (expected_bool ~key:strict_key DIAGS.Set.none) + in + let libpath, errors = + match Table.find copybook_key toml with + | TArray NodeTable tbl -> + copybook_entries tbl + | exception Not_found -> + default_libpath, DIAGS.Set.none + | _ -> + default_libpath, + expected ~key:copybook_key ~kind:"array of tables" DIAGS.Set.none + in + let source_format, sf_errors = + let none = DIAGS.Set.none in + match Table.find source_format_key toml with + | TString str -> + begin match String.uppercase_ascii str with + | "FREE" -> Cobol_config.SF SFFree, none + | "FIXED" -> SF SFFixed, none + | "VARIABLE" -> SF SFVariable, none + | "XOPEN" -> SF SFXOpen, none + | "XCARD" -> SF SFxCard, none + | "CRT" -> SF SFCRT, none + | "TERMINAL" -> SF SFTrm, none + | "COBOLX" -> SF SFCOBOLX, none + | "AUTO" -> Auto, none + | _ -> Auto, DIAGS.Set.error "Invalid source format: %s" str + end + | exception Not_found -> + Auto, none + | _ -> + Auto, expected_string ~key:source_format_key none + in + let errors = DIAGS.Set.union errors sf_errors in + let errors = + match config with + | Error diags -> DIAGS.Set.union errors diags + | Ok _ -> errors + in + let cobol_config, errors = + match config with + | Error _ -> + Cobol_config.default, + DIAGS.Acc.warn errors "Unsing the default configuration" + | Ok (config, diags) -> + config, DIAGS.Set.union errors diags + in + { + rootdir; + config_checksum = Some (Digest.file config_file); + cobol_config; + source_format; + libpath; + copybook_extensions = default_copybook_extensions; + copybook_if_no_extension = default_copybook_if_no_extension; + }, errors + | `Error (msg, _) -> + default ~rootdir, + DIAGS.Set.error "Failed to parse `superbol.toml': %s@\n\ + Using default configuration" msg + | exception e -> + default ~rootdir, + DIAGS.Set.error "Failed to read `superbol.toml': %a@\n\ + Using default configuration" Fmt.exn e + in + Lsp_diagnostics.publish @@ + Lsp_diagnostics.translate diags ~rootdir + ~uri:(`Main (Lsp.Uri.of_path config_file)); + config + +let try_reading_config_file ~layout:{ project_config_filename; _ } ~rootdir = + let config_filename = rootdir // project_config_filename in + if EzFile.exists config_filename + then read_config_file ~rootdir config_filename + else default ~rootdir + +let table = TABLE.create 1 + +let in_existing_dir dir ~layout = + if EzFile.is_directory dir then + let project = try_reading_config_file ~layout ~rootdir:dir in + TABLE.add table dir project; + project + else + Fmt.invalid_arg "Expected existing directory: %s" dir + +let for_ ~rootdir ~layout = + try TABLE.find table rootdir + with Not_found -> + let project = try_reading_config_file ~layout ~rootdir in + TABLE.add table rootdir project; + project + +let libpath_for ~uri { libpath; _ } = + List.map begin function + | RelativeToProjectRoot str -> str + | RelativeToFileDir str -> Filename.dirname (Lsp.Uri.to_path uri) // str + end libpath + +(* TODO: add config flags to libpath where some directories may only include + copybooks. *) +let detect_copybook ~uri { copybook_extensions; + copybook_if_no_extension; _ } = + let path = Lsp.Uri.to_path uri in + List.exists (Filename.check_suffix path) copybook_extensions || + (copybook_if_no_extension && Filename.extension path = "") + +let to_cache { config_checksum; cobol_config; source_format; libpath; + copybook_extensions; copybook_if_no_extension; _ } = + { + cached_config_checksum = config_checksum; + cached_cobol_config = cobol_config; + cached_source_format = source_format; + cached_libpath = libpath; + cached_copybook_extensions = copybook_extensions; + cached_copybook_if_no_extensions = copybook_if_no_extension; + } + +let of_cache ~rootdir ~layout + { cached_config_checksum = config_checksum; + cached_cobol_config = cobol_config; + cached_source_format = source_format; + cached_libpath = libpath; + cached_copybook_extensions = copybook_extensions; + cached_copybook_if_no_extensions = copybook_if_no_extension } + = + let project + = { rootdir; config_checksum; cobol_config; source_format; libpath; + copybook_extensions; copybook_if_no_extension } in + let config_filename = rootdir // layout.project_config_filename in + try match config_checksum with + | Some checksum when checksum = Digest.file config_filename -> + TABLE.replace table rootdir project; + project + | _ -> raise Exit + with _ -> (* read error or bad checksum (Exit) *) + let project = try_reading_config_file ~rootdir ~layout in + TABLE.add table rootdir project; + project + +let relative_path_for ~uri { rootdir; _ } = + try Lsp_utils.relative_path ~uri rootdir + with Invalid_argument _ -> Lsp.Uri.to_path uri (* if not in project rootdir *) + +let absolute_path_for ~filename { rootdir; _ } = + if EzFile.is_absolute filename + then filename (* in case the file is not within its project directory *) + else rootdir // filename diff --git a/src/lsp/cobol_lsp/lsp_project.mli b/src/lsp/cobol_lsp/lsp_project.mli new file mode 100644 index 000000000..2e92580ea --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_project.mli @@ -0,0 +1,93 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module TYPES: sig + + type path = + | RelativeToProjectRoot of string + | RelativeToFileDir of string + + type rootdir + + type project = private { + rootdir: rootdir; + config_checksum: Digest.t option; + cobol_config: Cobol_config.t; + source_format: Cobol_config.source_format_spec; + libpath: path list; + copybook_extensions: string list; + copybook_if_no_extension: bool; + } + + type layout = { + project_config_filename: string; + } + +end +include module type of TYPES + with type path = TYPES.path + and type rootdir = TYPES.rootdir + and type project = TYPES.project + and type layout = TYPES.layout + +type t = project + +(** [for_ ~rootdir ~layout] retrieves a project based on its root directory. + This may trigger reading project configuration files if the project was not + yet loaded. Any notification about the loading process is published + directly via {!Lsp_io.send_diagnostics} or {!Lsp_io.send_notification}. *) +val for_: rootdir:rootdir -> layout:layout -> t + +(** [in_existing_dir dirname ~layout] retrieves a project after checking + [dirname] actually refers to an exising directory that can serve as root for + the project. The same notes as {!for_} apply, with the addition that + {!Invalid_argument} may is raised in case [dirname] is not the name of an + existing directory. *) +val in_existing_dir: string -> layout:layout -> t + +(** [rootdir_for ~uri ~layout] locates the project directory (that contains a + file with given name [layout.project_config_filename]) for a file at the + given URI. Returns the name of the directory that contains the file at URI + if no project file is found. *) +val rootdir_for: uri:Lsp.Uri.t -> layout:layout -> rootdir + +(** [libpath_for ~uri project] constructs a list of directory names where + copybooks are looked up, for a source file at the given URI, in the given + project. *) +val libpath_for: uri:Lsp.Uri.t -> t -> string list + +(** [detect_copybook ~uri project] indicates whether a document at the given URI + for [project] should be treated as a copybook. *) +val detect_copybook: uri:Lsp.Uri.t -> t -> bool + +(** Cached representation *) + +type cached +val to_cache: t -> cached +val of_cache: rootdir:rootdir -> layout:layout -> cached -> t + +(** Sets and maps *) + +module SET: sig + include Set.S with type elt = t + val for_rootdir: rootdir:rootdir -> t -> elt + val mem_rootdir: rootdir:rootdir -> t -> bool +end +module MAP: Map.S with type key = t + +(** Miscellaneous *) + +val rootdir: t -> rootdir +val string_of_rootdir: rootdir -> string +val relative_path_for: uri:Lsp.Uri.t -> t -> string +val absolute_path_for: filename:string -> t -> string diff --git a/src/lsp/cobol_lsp/lsp_project_cache.ml b/src/lsp/cobol_lsp/lsp_project_cache.ml new file mode 100644 index 000000000..11c2fe2cc --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_project_cache.ml @@ -0,0 +1,141 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports +open Ez_file.V1 +open Ez_file.V1.EzFile.OP + +module DIAGS = Cobol_common.Diagnostics + +module TYPES = struct + type config = + { + cache_relative_filename: string; + cache_verbose: bool; + } +end +include TYPES + +(** Internal module used to hold a persistent representation of the set of + opened document pertaining to a given project. *) +module CACHED_DOCS = + Set.Make (struct + open Lsp_document.TYPES + type t = cached + let compare { doc_cache_filename = f1; _ } { doc_cache_filename = f2; _ } = + String.compare f1 f2 + end) + +type cached_project_record = + { + cached_project: Lsp_project.cached; + cached_docs: CACHED_DOCS.t; + } + +(* Code: *) + +let cache_filename ~config ~rootdir = + Lsp_project.string_of_rootdir rootdir // config.cache_relative_filename + +let version_tag_length = 40 (* use full commit hash when available *) +let version_tag = + let str = Option.value Version.commit_hash ~default:Version.version in + if String.length str >= version_tag_length + then String.sub str 0 version_tag_length + else str ^ String.make (version_tag_length - String.length str) '_' + +let write_project_cache cached_project_record oc = + output_string oc version_tag; + Marshal.to_channel oc (cached_project_record: cached_project_record) + [Closures] (* Still required for Cobol_config.t *) + +(** (Internal) Raises {!Failure} whenever the given input channel does not + contain a usable project cache structure. *) +let read_project_cache ic = + let version_tag' = really_input_string ic version_tag_length in + if version_tag' <> version_tag + then Fmt.failwith "Bad version tag: got %s, expected %s\ + " version_tag' version_tag; + (Marshal.from_channel ic: cached_project_record) + +(** (Internal) May raise {!Failure} or {!Sys_error}. *) +let save_project_cache ~config + (Lsp_project.{ rootdir; _ } as project) cached_docs = + let cached_project_record = + { + cached_project = Lsp_project.to_cache project; + cached_docs; + } + in + let cache_file = cache_filename ~config ~rootdir in + EzFile.(make_dir ~p:true (dirname cache_file)); + (* NB: don't really care if we rewrite the same cache again *) + (* if Lsp_utils.is_file cache_file *) + (* then (* read, write if commit hash or document changed *) *) + (* else *) + Lsp_utils.write_to cache_file (write_project_cache cached_project_record); + Lsp_io.pretty_notification "Wrote cache at: %s" cache_file ~type_:Info + +let save ~config docs = + (* Pivot all active projects: associate projects with all their documents, and + ignore any project that has none. *) + URIMap.fold begin fun _ (Lsp_document.{ project; _ } as doc) -> + Lsp_project.MAP.update project begin function + | None -> Some (CACHED_DOCS.singleton (Lsp_document.to_cache doc)) + | Some s -> Some (CACHED_DOCS.add (Lsp_document.to_cache doc) s) + end + end docs Lsp_project.MAP.empty |> + Lsp_project.MAP.iter (save_project_cache ~config) + +(** (Internal) *) +let load_project ~rootdir ~layout ~config { cached_project; cached_docs; _ } = + let project = Lsp_project.of_cache ~rootdir ~layout cached_project in + let add_doc doc docs = URIMap.add (Lsp_document.uri doc) doc docs in + CACHED_DOCS.fold begin fun cached_doc docs -> + try + let doc = Lsp_document.of_cache ~project cached_doc in + if config.cache_verbose then + Lsp_io.pretty_notification "Successfully read cache for %s" + (Lsp.Uri.to_string @@ Lsp_document.uri doc) ~log:true ~type_:Info; + add_doc doc docs + with + | Failure msg | Sys_error msg -> + if config.cache_verbose then + Lsp_io.pretty_notification "Failed to read cache for %s: %s" + cached_doc.doc_cache_filename msg ~log:true ~type_:Info; + docs + | e -> + Lsp_io.pretty_notification "Failed to read cache for %s: %a" + cached_doc.doc_cache_filename Fmt.exn e ~log:true ~type_:Warning; + docs + end cached_docs URIMap.empty + +let load ~rootdir ~layout ~config = + let fallback = URIMap.empty in + let cache_file = cache_filename ~config ~rootdir in + try + let cached_project = Lsp_utils.read_from cache_file read_project_cache in + let project = load_project ~rootdir ~layout ~config cached_project in + Lsp_io.pretty_notification "Successfully read cache for %s" + (Lsp_project.string_of_rootdir rootdir) ~log:true ~type_:Info; + project + with + | Failure msg | Sys_error msg -> + if config.cache_verbose then + Lsp_io.pretty_notification "Failed to read cache file %s: %s" + cache_file msg ~log:true ~type_:Info; + fallback + | e -> + Lsp_io.pretty_notification "Failed to read cache file %s: %a" + cache_file Fmt.exn e ~log:true ~type_:Warning; + fallback diff --git a/src/lsp/cobol_lsp/lsp_project_cache.mli b/src/lsp/cobol_lsp/lsp_project_cache.mli new file mode 100644 index 000000000..75312de99 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_project_cache.mli @@ -0,0 +1,56 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports + +module TYPES: sig + type config = + { + (** Name of cache file, relative to project root directory. *) + cache_relative_filename: string; + cache_verbose: bool; + } +end +include module type of TYPES + with type config = TYPES.config + +(** [save ~config docs] saves the caches of all the given document's + projects. + + For any project [p] of which at least one document belongs to [docs], any + document of [p] that does not belong to [docs] is removed from [p]'s + cache. + + Some notifications about the saving process may be pushed via + {!Lsp_io.send_notification}. May raise some IO-related exceptions + ({!Sys_error}, {!Failure}). *) +val save + : config: TYPES.config + -> Lsp_document.t URIMap.t + -> unit + +(** [load ~rootdir ~config ~layout] pre-loads cached documents pertaining to a + project located in [rootdir], with project directory layout [layout]. + + All projects in the returned map belong to the same project. Note this map + may actually be empty (for instance in case of missing, out-dated cache + files, or cache files for a different version of the library). + + Some notifications about the loading process may be pushed via + {!Lsp_io.send_notification}. May raise some IO-related exceptions + ({!Sys_error}, {!Failure}). *) +val load + : rootdir:Lsp_project.rootdir + -> layout: Lsp_project.layout + -> config: TYPES.config + -> Lsp_document.t URIMap.t diff --git a/src/lsp/cobol_lsp/lsp_request.ml b/src/lsp/cobol_lsp/lsp_request.ml new file mode 100644 index 000000000..9de767d0e --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_request.ml @@ -0,0 +1,379 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Lsp_imports +open Lsp_project.TYPES +open Lsp_server.TYPES +open Lsp_lookup.TYPES +open Lsp.Types +open Ez_file.V1 + + +(** Some preliminary utilities for manipulating source locations *) + +type loc_translator = + { + location_of_srcloc: srcloc -> Location.t; + location_of: 'x. 'x with_loc -> Location.t; + } + +let loc_translator TextDocumentIdentifier.{ uri } = + let filename = Lsp.Uri.to_path uri in + let location_of_srcloc loc = + let range = Lsp_position.range_of_srcloc_in ~filename loc in + Location.create ~uri ~range + in + { + location_of_srcloc; + location_of = fun { loc; _ } -> location_of_srcloc loc; + } + + +(** Catching cases where we miss some document data *) + +let try_with_document_data ?(on_error = None) ~f registry document_id = + try + let Lsp_document.{ project; textdoc; pplog; tokens; _ } as doc = + Lsp_server.find_document document_id registry in + f ~project ~textdoc ~pplog ~tokens @@ Lsp_document.retrieve_parsed_data doc + with e -> + Lsp_io.pretty_notification ~type_:Warning "Caught exception: %a" Fmt.exn e; + on_error + +(** Handling requests *) + +(* Client capabilities are to be used for special request response, for example + a definition request can be answered with a LocationLink iff the client + supports it. + + NOTE: For now we don't use them because we don't have any special + response. *) +let make_capabilities _ = + let sync = + TextDocumentSyncOptions.create () + ~openClose:true + ~change:Incremental + in + let semantic = + let full = SemanticTokensOptions.create_full ~delta:false () in + let legend = SemanticTokensLegend.create + ~tokenTypes:Lsp_semantic.tokens_types + ~tokenModifiers:Lsp_semantic.tokens_modifiers + in + SemanticTokensOptions.create () + ~full:(`Full full) ~legend + in + let hover = HoverOptions.create () in + let completion_option = CompletionOptions.create () in + + ServerCapabilities.create () + ~textDocumentSync:(`TextDocumentSyncOptions sync) + ~definitionProvider:(`Bool true) + ~referencesProvider:(`Bool true) + ~documentRangeFormattingProvider: (`Bool true) + ~documentFormattingProvider: (`Bool true) + ~semanticTokensProvider:(`SemanticTokensOptions semantic) + ~hoverProvider:(`HoverOptions hover) + ~completionProvider:(completion_option) + +let handle_initialize (params: InitializeParams.t) = + InitializeResult.create () + ~capabilities:(make_capabilities params.capabilities) + +let find_definitions { location_of; _ } cu_name qn defs = + let location_of_item { item_definition; _ } = + match item_definition.payload with + | CondName {condition_name = name; _} + | Renames {rename_to = name; _}-> + location_of name + | Constant {constant_name = Some name; _} + | Data {data_name = Some name; _} + | Screen {screen_data_name = Some name; _} + | ReportGroup {report_data_name = Some name; _} -> + location_of name + | _ -> raise Not_found + in + try + let _cu, cu_defs = CUMap.find_by_name cu_name defs in + let { as_item; as_paragraph } = Cobol_data.Qualmap.find qn cu_defs in + Option.((to_list @@ map location_of_item as_item) @ + (to_list @@ map location_of as_paragraph)) + with Not_found -> [] + +let lookup_definition_in_doc + DefinitionParams.{ textDocument = doc; position; _ } + Lsp_document.{ ast = ptree; definitions = defs; _ } + = + match Lsp_lookup.names_at_position ~uri:doc.uri position ptree with + | { qualname_at_position = None; _ } + | { enclosing_compilation_unit_name = None; _ } -> + None + | { qualname_at_position = Some qn; + enclosing_compilation_unit_name = Some cu_name } -> + let defs = Lazy.force defs in + let loc_translator = loc_translator doc in + Some (`Location (find_definitions loc_translator cu_name qn defs)) + +let handle_definition registry (params: DefinitionParams.t) = + try_with_document_data registry params.textDocument + ~f:(fun ~project:_ ~textdoc:_ ~pplog:_ ~tokens:_ -> + lookup_definition_in_doc params) + +let lookup_references_in_doc + ReferenceParams.{ textDocument = doc; position; context; _ } + Lsp_document.{ ast = ptree; definitions = defs; references = refs; _ } + = + match Lsp_lookup.names_at_position ~uri:doc.uri position ptree with + | { enclosing_compilation_unit_name = None; _ } -> + None + | { qualname_at_position = qn; + enclosing_compilation_unit_name = Some cu_name } -> + let { location_of_srcloc; _ } as loc_translator = loc_translator doc in + let def_locs = + match qn with + | Some qn when context.includeDeclaration -> + find_definitions loc_translator cu_name qn (Lazy.force defs) + | Some _ | None -> + [] + in + let ref_locs = + try + match qn with + | None -> [] + | Some qn -> + let refs = Lazy.force refs in + let _cu, cu_refs = CUMap.find_by_name cu_name refs in + List.map location_of_srcloc + (Cobol_data.Qualmap.find qn cu_refs) + with Not_found -> [] + in + Some (def_locs @ ref_locs) + +let handle_references state (params: ReferenceParams.t) = + try_with_document_data state params.textDocument + ~f:(fun ~project:_ ~textdoc:_ ~pplog:_ ~tokens:_ -> + lookup_references_in_doc params) + + +(*Remark: + The first line of the text selected to RangeFormatting must be + the begin of statement/paragraph/section/division/01 level data declaration, + and the text selected must terminate in the same scope. + Otherwise, unexpected result. +*) +let handle_range_formatting registry params = + let open DocumentRangeFormattingParams in + let { textDocument = doc; range = {start; end_}; _ } = params in + let Lsp_document.{ project; _ } = Lsp_server.find_document doc registry in + let range_to_indent = + Cobol_indent.Type.{ + start_line = start.line + 1; + end_line = end_.line + 1 + } + in + (*the range must contain the whole lines*) + let range = + (*TODO:find a simple method to get the number of letters of one line + (the code below use 1000 as the upperbound) *) + Range.{ + start = Position.create ~line:start.line ~character:0; + end_ = Position.create ~line:end_.line ~character:1000; + } + in + let newText = + Cobol_indent.indent_range' + ~source_format:project.source_format + ~indent_config:None + ~file:(Lsp.Uri.to_path doc.uri) + ~range:(Some range_to_indent) + in + Some [TextEdit.create ~newText ~range] + +let handle_formatting registry params = + let DocumentFormattingParams.{ textDocument = doc; _ } = params in + let Lsp_document.{ project; textdoc; _ } = + Lsp_server.find_document doc registry in + let lines = String.split_on_char '\n' (Lsp.Text_document.text textdoc) in + let length = List.length lines - 1 in + (* TODO: formatting on empty files will break here *) + let width = String.length @@ List.hd @@ List.rev lines in + let edit_range = + Range.create + ~start:(Position.create ~character:0 ~line:0) + ~end_:(Position.create ~character:width ~line:length) + in + let path = Lsp.Uri.to_path doc.uri in + let newText = + Cobol_indent.indent_range' + ~source_format:project.source_format + ~indent_config:None + ~file:path + ~range:None + in + Some [TextEdit.create ~newText ~range:edit_range] + +let handle_semantic_tokens_full registry (params: SemanticTokensParams.t) = + try_with_document_data registry params.textDocument + ~f:begin fun ~project:_ ~textdoc:_ ~pplog:_ ~tokens Lsp_document.{ ast; _ } -> + let filename = Lsp.Uri.to_path params.textDocument.uri in + let data = Lsp_semantic.data ~filename (Lazy.force tokens) ast in + Some (SemanticTokens.create ~data ()) + end + +let handle_hover registry (params: HoverParams.t) = + let filename = Lsp.Uri.to_path params.textDocument.uri in + let find_hovered_replacement pplog = + List.find_opt begin fun Cobol_preproc.{ matched_loc; _ } -> + Lsp_position.is_in_lexloc params.position + (Cobol_common.Srcloc.lexloc_in ~filename matched_loc) + end pplog + in + let hover_markdown ~loc value = + let content = MarkupContent.create ~kind:MarkupKind.Markdown ~value in + let range = Lsp_position.range_of_srcloc_in ~filename loc in + Some (Hover.create () ~contents:(`MarkupContent content) ~range) + in + try_with_document_data registry params.textDocument + ~f:begin fun ~project ~textdoc:_ ~pplog ~tokens:_ { ast; _ } -> + match Lsp_lookup.copy_at_pos ~filename params.position ast with + | Some { payload = lib; loc } -> + let text = EzFile.read_file lib in + (* TODO: grab source-format from preprocessor state? *) + let module Config = (val project.cobol_config) in + let mdlang = match Config.format#value with + | SF (SFFree | SFVariable | SFCOBOLX) -> "cobolfree" + | SF _ | Auto -> "cobol" + in + Pretty.string_to (hover_markdown ~loc) "```%s\n%s\n```" mdlang text + | None -> + match find_hovered_replacement pplog with + | None -> None + | Some Cobol_preproc.{ matched_loc = loc; replacement_text; _ } -> + Pretty.string_to (hover_markdown ~loc) "``@[%a@]``" + Cobol_preproc.Text.pp_text replacement_text + end + +let handle_completion registry (params:CompletionParams.t) = + let open Lsp_completion in + try_with_document_data registry params.textDocument + ~f:begin fun ~project:_ ~textdoc ~pplog:_ ~tokens:_ { ast; _ } -> + let items = completion_items textdoc params.position ast in + let completionlist = CompletionList.create ~isIncomplete:false ~items () in + Some (`CompletionList completionlist) + end + +let handle_shutdown registry = + try Lsp_server.save_project_caches registry + with e -> Pretty.error "Exception caught while saving project caches: %a@.\ + " Fmt.exn e + +let on_request + : type r. state -> r Lsp.Client_request.t -> + id:Jsonrpc.Id.t -> (r * state, r error) result = + fun state client_req ~id:_ -> + match state, client_req with + | NotInitialized config, Lsp.Client_request.Initialize init_params -> + Ok (handle_initialize init_params, Initialized config) + | NotInitialized _, _ -> + Error (InvalidStatus state) + | (ShuttingDown | Initialized _ | Exit _) as state, _ -> + Error (InvalidStatus state) + | Running registry, _ -> match client_req with + | Initialize _ -> + Error (InvalidStatus (Running registry)) + | TextDocumentDefinition def_params -> + Ok (handle_definition registry def_params, state) + | TextDocumentReferences ref_params -> + Ok (handle_references registry ref_params, state) + | TextDocumentRangeFormatting params -> + Ok (handle_range_formatting registry params, state) + | TextDocumentFormatting params -> + begin try Ok (handle_formatting registry params, state) + with Failure msg -> Error (FormattingError msg) end + | SemanticTokensFull semantic_params -> + Ok (handle_semantic_tokens_full registry semantic_params, state) + | TextDocumentHover hover_params -> + Ok (handle_hover registry hover_params, state) + | TextDocumentCompletion completion_params -> + Ok (handle_completion registry completion_params, state) + | Shutdown -> + Ok (handle_shutdown registry, ShuttingDown) + | TextDocumentDeclaration (* TextDocumentPositionParams.t.t *) _ + | TextDocumentTypeDefinition (* TypeDefinitionParams.t.t *) _ + | TextDocumentImplementation (* ImplementationParams.t.t *) _ + | TextDocumentCodeLens (* CodeLensParams.t.t *) _ + | TextDocumentCodeLensResolve (* CodeLens.t.t *) _ + | TextDocumentPrepareCallHierarchy (* CallHierarchyPrepareParams.t.t *) _ + | TextDocumentPrepareRename (* PrepareRenameParams.t.t *) _ + | TextDocumentRename (* RenameParams.t.t *) _ + | TextDocumentLink (* DocumentLinkParams.t.t *) _ + | TextDocumentLinkResolve (* DocumentLink.t.t *) _ + | TextDocumentMoniker (* MonikerParams.t.t *) _ + | DocumentSymbol (* DocumentSymbolParams.t.t *) _ + | WorkspaceSymbol (* WorkspaceSymbolParams.t.t *) _ + | DebugEcho (* DebugEcho.Params.t *) _ + | DebugTextDocumentGet (* DebugTextDocumentGet.Params.t *) _ + | TextDocumentHighlight (* DocumentHighlightParams.t.t *) _ + | TextDocumentFoldingRange (* FoldingRangeParams.t.t *) _ + | SignatureHelp (* SignatureHelpParams.t.t *) _ + | CodeAction (* CodeActionParams.t.t *) _ + | CodeActionResolve (* CodeAction.t.t *) _ + | CompletionItemResolve (* CompletionItem.t.t *) _ + | WillSaveWaitUntilTextDocument (* WillSaveTextDocumentParams.t.t *) _ + | TextDocumentOnTypeFormatting (* DocumentOnTypeFormattingParams.t.t *) _ + | TextDocumentColorPresentation (* ColorPresentationParams.t.t *) _ + | TextDocumentColor (* DocumentColorParams.t.t *) _ + | SelectionRange (* SelectionRangeParams.t.t *) _ + | ExecuteCommand (* ExecuteCommandParams.t.t *) _ + | SemanticTokensDelta (* SemanticTokensDeltaParams.t.t *) _ + | SemanticTokensRange (* SemanticTokensRangeParams.t.t *) _ + | LinkedEditingRange (* LinkedEditingRangeParams.t.t *) _ + | CallHierarchyIncomingCalls (* CallHierarchyIncomingCallsParams.t.t *) _ + | CallHierarchyOutgoingCalls (* CallHierarchyOutgoingCallsParams.t.t *) _ + | WillCreateFiles (* CreateFilesParams.t.t *) _ + | WillDeleteFiles (* DeleteFilesParams.t.t *) _ + | WillRenameFiles (* RenameFilesParams.t.t *) _ + -> + Error (UnhandledRequest client_req) + | UnknownRequest { meth ; params=_ } -> + Error (UnknownRequest meth) + +let handle req state = + match Lsp.Client_request.of_jsonrpc req with + | Ok (E r) -> + let response, state = + match on_request state r ~id:req.id with + | Ok (reply, state) -> + let reply_json = Lsp.Client_request.yojson_of_result r reply in + Jsonrpc.Response.ok req.id reply_json, state + | Error server_error -> + let json_error = + Lsp_server.jsonrpc_of_error server_error req.method_ in + Jsonrpc.Response.error req.id json_error, state + | exception e -> + Jsonrpc.Response.error req.id @@ Jsonrpc.Response.Error.of_exn e, state + in + Lsp_io.send_response response; + state + | Error str -> + Pretty.failwith "Could not read request: %s" str + +module INTERNAL = struct + let lookup_definition = handle_definition + let lookup_definition_in_doc = lookup_definition_in_doc + let lookup_references = handle_references + let lookup_references_in_doc = lookup_references_in_doc + let hover = handle_hover + let formatting = handle_formatting +end diff --git a/src/lsp/cobol_lsp/lsp_request.mli b/src/lsp/cobol_lsp/lsp_request.mli new file mode 100644 index 000000000..2bd0cbbf5 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_request.mli @@ -0,0 +1,41 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val handle: Jsonrpc.Request.t -> (Lsp_server.state as 's) -> 's + +module INTERNAL: sig + val lookup_definition + : Lsp_server.t + -> Lsp.Types.DefinitionParams.t + -> [> `Location of Lsp.Types.Location.t list ] option + val lookup_definition_in_doc + : Lsp.Types.DefinitionParams.t + -> Lsp_document.parsed_data + -> [> `Location of Lsp.Types.Location.t list ] option + val lookup_references + : Lsp_server.t + -> Lsp.Types.ReferenceParams.t + -> Lsp.Types.Location.t list option + val lookup_references_in_doc + : Lsp.Types.ReferenceParams.t + -> Lsp_document.parsed_data + -> Lsp.Types.Location.t list option + val hover + : Lsp_server.t + -> Lsp.Types.HoverParams.t + -> Lsp.Types.Hover.t option + val formatting + : Lsp_server.t + -> Lsp.Types.DocumentFormattingParams.t + -> Lsp.Types.TextEdit.t list option +end diff --git a/src/lsp/cobol_lsp/lsp_semantic.ml b/src/lsp/cobol_lsp/lsp_semantic.ml new file mode 100644 index 000000000..723d52e9e --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_semantic.ml @@ -0,0 +1,622 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common (* Srcloc, Visitor *) +open Cobol_common.Srcloc.INFIX +open Cobol_parser.Grammar_tokens + +type semantic_token = { + line: int; + start: int; + length: int; + token_type: string; + token_modifiers: string list; +} + +let tokens_types = [ + "type"; + "operator"; + "variable"; + "function"; + "parameter"; + "keyword"; + "string"; + "number"; + "namespace"; + "decorator"; + "modifier"; + "comment"; + (* "class"; *) + (* "enum"; *) + (* "interface"; *) + (* "struct"; *) + (* "typeParameter"; *) + (* "property"; *) + (* "enumMember"; *) + (* "event"; *) + (* "method"; *) + (* "macro"; *) + (* "regexp"; *) +] + +let tokens_modifiers = [ + "declaration"; + "definition"; + "readonly"; + "modification"; + "defaultLibrary"; +(*"static"; + "deprecated"; + "abstract"; + "async"; + "documentation";*) +] + +let semantic_token lexloc token_type token_modifiers = + let range = Lsp_position.range_of_lexloc lexloc in + let line = range.start.line in + let start = range.start.character in + let length = range.end_.character - start in + { line; start; length; token_type; token_modifiers } + +type token_type = + | ProgramName + | ParagraphName + | ProcName + | Parameter + | DataDecl + | DataLevel + | Var + | VarModif + | ReportName + | ExceptionName + | MnemonicName + | FileName + +let semantic_visitor ~filename = + let open Cobol_parser.PTree_visitor in + let open Cobol_ast.Terms_visitor in + let open Cobol_ast.Operands_visitor in + let open Cobol_common.Visitor in + + let semantic_token_of lexloc token_type = + let semantic_token_of lexloc (token_type, token_modifiers) = + semantic_token lexloc token_type token_modifiers + in + semantic_token_of lexloc @@ match token_type with + | ProgramName -> "string", ["definition"; "readonly"] + | ParagraphName -> "function", ["definition"] + | ProcName -> "function", [] + | Parameter -> "parameter", [] + | DataDecl -> "variable", ["declaration"] + | DataLevel -> "decorator", [] + | Var -> "variable", [] + | VarModif -> "variable", ["modification"] + | ReportName + | ExceptionName + | MnemonicName + | FileName -> "variable", ["readonly"] + in + let add_name' name token_type acc = + match Srcloc.lexloc_in ~filename ~@name with + | lexloc -> List.cons (semantic_token_of lexloc token_type) acc + | exception Invalid_argument _ -> acc + in + let rec add_qualname (qn:Cobol_ast.qualname) token_type acc = + match qn with + | Name name -> + add_name' name token_type acc + | Qual (name, qn) -> + add_name' name token_type acc |> add_qualname qn token_type + in + let add_ident (id:Cobol_ast.ident) token_type acc = + match id with + | QualIdent {ident_name; _} -> add_qualname ident_name token_type acc + | _ -> acc (* TODO *) + in + let add_ident' id = add_ident ~&id in + let add_list add_fun l token_type acc = + List.fold_left (fun acc n -> add_fun n token_type acc) acc l + in + let add_option add_fun v token_type acc = + match v with + | None -> acc + | Some v -> add_fun v token_type acc + in + + Cobol_parser.PTree_visitor.fold_compilation_group (object (self) + inherit [semantic_token List.t] Cobol_parser.PTree_visitor.folder + + (* program-name *) + method! fold_program_unit {program_name; _} acc = acc + |> add_name' program_name ProgramName + |> Visitor.do_children + (* we call do_children, so we must ensure that + the fold_name' does nothing, + otherwise, there will be token overlap. + + Or we can override this method fold_program_unit to explicitly + fold its every child and return Visitor.skip_children x. + But by doing that for every method(which we need to override), + we have to write a great amount of code... like rewriting + the code of Cobol_ast. + + *) + + (*TODO: File/Report section*) + + (* data-name *) + method! fold_data_name data_name acc = + match data_name with + | DataName n -> acc + |> add_name' n DataDecl + |> Visitor.skip_children + | _ -> + Visitor.do_children acc + + method! fold_rename_item {rename_level; rename_to; + rename_renamed; rename_through } acc = acc + |> add_name' rename_to DataDecl + (*|> Visitor.do_children*) + (* We can remove the code below and return do_children directly*) + |> fold_data_level' self rename_level + |> fold_qualname self rename_renamed + |> fold_qualname_opt self rename_through + |> Visitor.skip_children + + method! fold_condition_name_item { condition_name_level; + condition_name; + condition_name_values; + condition_name_alphabet; + condition_name_when_false } acc = acc + |> add_name' condition_name DataDecl + (*|> Visitor.do_children *) + |> fold_data_level' self condition_name_level + |> fold_list ~fold:fold_condition_name_value self condition_name_values + |> fold_name'_opt self condition_name_alphabet + |> fold_literal_opt self condition_name_when_false + |> Visitor.skip_children + + method! fold_data_clause dc acc = + match dc with + | DataRedefines name -> acc + |> add_name' name Var + |> Visitor.skip_children + | _ -> + Visitor.skip_children acc (*Not implmented*) + + (* data-level *) + (* TODO: condition_name ??*) + method! fold_data_level' dl acc = acc + |> add_name' dl DataLevel + |> Visitor.skip_children + + (* paragraph name *) + method! fold_paragraph { paragraph_name; paragraph_is_section; + paragraph_segment; paragraph_sentences } acc = + ignore paragraph_is_section; acc + |> add_option add_name' paragraph_name ParagraphName + (*|> Visitor.do_children*) + |> fold_integer_opt self paragraph_segment + |> fold_list ~fold:(fun v -> v#continue_with_statements') self paragraph_sentences + |> Visitor.skip_children + + (* procedure using *) + method! fold_using_by_reference { using_by_reference; + using_by_reference_optional } acc = acc + |> add_name' using_by_reference Parameter + (*|> Visitor.do_children*) + |> fold_bool self using_by_reference_optional + |> Visitor.skip_children + + method! fold_using_clause = function + | UsingByReference _ -> + Visitor.do_children + | UsingByValue l -> fun x -> x + |> add_list add_name' l Parameter + |> Visitor.skip_children + + (* inline call of function *) + method! fold_inline_call { call_fun; call_args; call_refmod } acc = acc + |> add_name' call_fun ProcName + |> fold_list ~fold:fold_effective_arg self call_args + |> fold_option ~fold:fold_refmod self call_refmod + |> Visitor.skip_children + + (* Statement *) + (* distinguish + 1 variable + 2 variable modified + 3 procedure-name + 4 report-name/file-name/exception-name/mnemonic-name *) + (*TODO: maybe finer analysis*) + + method! fold_accept' {payload = accept_stmt; _} acc = + match accept_stmt with + | AcceptFromDevice { item; device_item } -> acc + |> add_name' device_item MnemonicName + (*|> Visitor.do_children*) + |> fold_ident' self item + |> Visitor.skip_children + | AcceptGeneric _ + | AcceptTemporal _ + | AcceptMsgCount _ + | AcceptAtScreen _ + | AcceptFromEnv _ -> + Visitor.do_children acc + + method! fold_allocate' {payload = { allocate_kind; + allocate_initialized; + allocate_returning }; _ } acc = acc + |> fold_allocate_kind self allocate_kind + |> fold_bool self allocate_initialized + |> add_option add_ident' allocate_returning VarModif + |> Visitor.skip_children + + (*TODO: Alter *) + + method! fold_call' {payload = { call_prefix; call_using; + call_returning; + call_error_handler }; _} acc = acc + |> fold_call_prefix self call_prefix + |> fold_list ~fold:fold_call_using_clause' self call_using + |> add_option add_ident' call_returning VarModif + |> fold_option ~fold:fold_call_error_handler self call_error_handler + |> Visitor.skip_children + + (*TODO: Cancel *) + + method! fold_close_phrase { close_item; close_format} acc = acc + |> add_name' close_item FileName + (*|> Visitor.do_children*) + |> fold_option ~fold:fold_close_format self close_format + |> Visitor.skip_children + + (* Add Compute Divide Multiply Subtract *) + method! fold_rounded_ident { rounded_ident; rounded_rounding } acc = acc + |> add_ident rounded_ident VarModif + |> fold_rounding self rounded_rounding + |> Visitor.skip_children + + method! fold_delete' {payload = { delete_targets; delete_retry; + delete_on_invalid_key }; _} acc = acc + |> add_name' delete_targets FileName + (*|> Visitor.do_children*) + |> fold_option ~fold:fold_retry_clause self delete_retry + |> fold_dual_handler self delete_on_invalid_key + |> Visitor.skip_children + + method! fold_display' { payload; _ } acc = + Visitor.do_children_and_then acc @@ match payload with + | DisplayDevice { upon = Some { payload = DisplayUponName n; _ }; _ } -> + add_name' n MnemonicName + | _ -> + Fun.id + + (*TODO: Exit *) + + method! fold_free' names acc = acc + |> add_list add_name' ~&names VarModif + |> Visitor.skip_children + + method! fold_generate' name acc = acc + |> add_name' ~&name VarModif + |> Visitor.skip_children + + method! fold_goto' {payload = goto_target; _} acc = acc + |> add_qualname goto_target ProcName + |> Visitor.skip_children + + method! fold_goto_depending' {payload = { goto_depending_targets; + goto_depending_on }; _} acc = acc + |> add_list add_qualname goto_depending_targets ProcName + |> fold_ident self goto_depending_on + |> Visitor.skip_children + + method! fold_initialize' {payload = { init_items; init_filler; init_category; + init_replacings; init_to_default }; _} acc = acc + |> add_list add_ident init_items VarModif + |> fold_bool self init_filler + |> fold_option ~fold:fold_init_category self init_category + |> fold_list ~fold:fold_init_replacing self init_replacings + |> fold_bool self init_to_default + |> Visitor.skip_children + + method! fold_initiate' { payload = names; _} acc = acc + |> add_list add_name' names ReportName + |> Visitor.skip_children + + method! fold_tallying { tallying_target; tallying_clauses } acc = acc + |> add_qualname tallying_target.ident_name VarModif + |> fold_list ~fold:fold_tallying_clause' self tallying_clauses + |> Visitor.skip_children + + method! fold_inspect' { payload = { inspect_item; inspect_spec }; _} acc = acc + |> add_ident inspect_item VarModif + |> fold_inspect_spec self inspect_spec + |> Visitor.skip_children + + (*TODO: Invoke *) + + method! fold_move' {payload = move_stmt; _} acc = + match move_stmt with + | MoveSimple { from; to_ } -> acc + |> fold_ident_or_literal self from + |> add_list add_ident to_ VarModif + |> Visitor.skip_children + | MoveCorresponding { from; to_ } -> acc + |> fold_ident self from + |> add_list add_ident to_ VarModif + |> Visitor.skip_children + + method! fold_named_file_option {named_file_name; + named_file_option} acc = acc + |> add_name' named_file_name FileName + (*|> Visitor.do_children*) + |> fold_option ~fold:fold_file_option self named_file_option + |> Visitor.skip_children + + method! fold_perform_target perform_target acc = + match perform_target with + | PerformOutOfLine { procedure_start; procedure_end } -> acc + |> add_qualname procedure_start ProcName + |> add_option add_qualname procedure_end ProcName + |> Visitor.skip_children + | PerformInline _ -> + Visitor.do_children acc + + method! fold_varying_phrase { varying_ident; varying_from; + varying_by; varying_until } acc = acc + |> add_ident varying_ident VarModif + |> fold_ident_or_numlit self varying_from + |> fold_option ~fold:fold_ident_or_numlit self varying_by + |> fold_condition self varying_until + |> Visitor.skip_children + + method! fold_raise' {payload = raise_stmt; _} acc = + match raise_stmt with + | RaiseIdent _ -> Visitor.do_children acc + | RaiseException name -> acc + |> add_name' name ExceptionName + |> Visitor.skip_children + + method! fold_read' {payload = { read_file; read_direction; + read_into; read_lock_behavior; + read_lock; read_key; + read_error_handler }; _} acc = acc + |> add_name' read_file FileName + |> fold_option ~fold:fold_read_direction self read_direction + |> add_option add_ident read_into VarModif + |> fold_option ~fold:fold_read_lock_behavior self read_lock_behavior + |> fold_option ~fold:fold_bool self read_lock + |> fold_option ~fold:fold_qualname self read_key + |> fold_option ~fold:fold_read_error_handler self read_error_handler + |> Visitor.skip_children + + (* TODO: RELEASE *) + + method! fold_resume' {payload = qn; _} acc = acc + |> add_qualname qn ProcName + |> Visitor.skip_children + + method! fold_return' {payload = {return_file; return_into; + return_at_end}; _} acc = acc + |> add_name' return_file FileName + |> add_option add_ident' return_into VarModif + |> fold_dual_handler self return_at_end + |> Visitor.skip_children + + method! fold_write_target write_target acc = + match write_target with + | WriteTargetName _ -> Visitor.do_children acc + | WriteTargetFile name -> acc + |> add_name' name FileName + |> Visitor.skip_children + + method! fold_search_spec search_spec acc = + match search_spec with + | SearchSerial { varying; when_clauses } -> acc + |> add_option add_ident varying VarModif + |> fold_list ~fold:fold_search_when_clause' self when_clauses + |> Visitor.skip_children + | SearchAll _ -> Visitor.do_children acc + + method! fold_set_switch_spec {set_switch_targets; + set_switch_value } acc = acc + |> add_list add_ident set_switch_targets MnemonicName (*TODO: ident??*) + |> fold_on_off self set_switch_value + |> Visitor.skip_children + + method! fold_set_condition_spec { set_condition_targets; + set_condition_value } acc = acc + |> add_list add_ident set_condition_targets VarModif + |> fold_bool self set_condition_value + |> Visitor.skip_children + + method! fold_set' {payload = set_stmt;_ } acc = + match set_stmt with + | SetAmbiguous { targets; set_method; value} -> acc + |> add_list add_ident targets VarModif + |> fold_set_ambiguous_method self set_method + |> fold_expression self value + |> Visitor.skip_children + | SetSwitch _ (*TODO*) + | SetCondition _ + | SetAttribute _ + | SetLocale _ + | SetSavedException -> + Visitor.do_children acc + | SetSaveLocale { target; locale } -> acc + |> add_ident target VarModif + |> fold_set_save_locale self locale + |> Visitor.skip_children + | SetFloatContent { targets; content; sign } -> acc + |> add_list add_ident targets VarModif + |> fold_float_content self content + |> fold_option ~fold:fold_sign self sign + |> Visitor.skip_children + + method! fold_start' {payload = {start_file; start_position; + start_on_invalid_key }; _} acc = acc + |> add_name' start_file FileName + (*|> Visitor.do_children*) + |> fold_option ~fold:fold_start_position self start_position + |> fold_dual_handler self start_on_invalid_key + |> Visitor.skip_children + + method! fold_string_stmt' {payload = {string_sources; + string_target; + string_pointer; + string_on_overflow}; _} acc = acc + |> add_ident string_target VarModif + |> fold_list ~fold:fold_string_source self string_sources + |> fold_option ~fold:fold_ident self string_pointer + |> fold_dual_handler self string_on_overflow + |> Visitor.skip_children + + method! fold_terminate' {payload = names; _} acc = acc + |> add_list add_name' names ReportName + |> Visitor.skip_children + + method! fold_unlock' {payload = { unlock_file; unlock_record }; _} acc = acc + |> add_name' unlock_file FileName + (*|> Visitor.do_children*) + |> fold_bool self unlock_record + |> Visitor.skip_children + + method! fold_unstring_target { unstring_target; + unstring_target_delimiter; + unstring_target_count} acc = acc + |> add_ident unstring_target VarModif + |> add_option add_ident unstring_target_delimiter VarModif + |> add_option add_ident unstring_target_count VarModif + |> Visitor.skip_children + + (*TODO: Validate *) + (*TODO: Merge, Sort*) + + (* All qualname not colored yet will be marked as normal variable *) + method! fold_qualname qn acc = acc + |> add_qualname qn Var + |> Visitor.skip_children + + end) + +(** [make_non_ambigious tokens] returns tokens that do not need to have more analyzing to get their + type. *) +let make_non_ambigious ~filename tokens = tokens |> + List.filter_map + (fun { payload; loc } -> + try Some (payload, Srcloc.lexloc_in ~filename loc) with _ -> None) |> + List.filter_map + (fun (token, lexloc) -> + match token with + | WORD _ | WORD_IN_AREA_A _ -> None + | ALPHANUM _ | ALPHANUM_PREFIX _ -> + Some (semantic_token lexloc "string" []) + | BOOLIT _ + | HEXLIT _ | NULLIT _ + | NATLIT _ | SINTLIT _ + | FIXEDLIT _ | FLOATLIT _ + | DIGITS _ + | EIGHTY_EIGHT -> + Some (semantic_token lexloc "number" []) + | PICTURE_STRING _ -> + Some (semantic_token lexloc "type" ["declaration"]) + (* | EQUAL | PLUS | MINUS *) + | AMPERSAND | ASTERISK | COLON | DASH_SIGN | DOUBLE_ASTERISK | DOUBLE_COLON + | EQ | GE | GT | LE | LPAR | LT | NE | PLUS_SIGN | RPAR | SLASH -> + Some (semantic_token lexloc "operator" []) + | PARAGRAPH | STATEMENT | PROGRAM |SECTION | DIVISION -> + Some (semantic_token lexloc "namespace" []) + | ACCEPT | ACCESS | ADD | ALLOCATE | ALTER | APPLY | ARE | ASSIGN | CALL | CANCEL | CHAIN | CLOSE + | COMMIT | COMPUTE | CONTINUE | CONTROL | CONTROLS | COPY | COPY_SELECTION | COUNT | CYCLE + | DELETE | DESTROY | DISABLE | DISP | DISPLAY | DISPLAY_1 | DISPLAY_COLUMNS | DISPLAY_FORMAT + | DIVIDE | ENABLE | ENSURE_VISIBLE | ENTER | ERASE | ESCAPE | EVALUATE | EXAMINE | EXHIBIT | EXIT + | FREE | GENERATE | GET | GO | GOBACK | GO_BACK | GO_FORWARD | GO_HOME | GO_SEARCH | IF | IGNORE + | INITIALIZE | INITIATE | INSPECT | INVOKE | LEAVE | LOCK | LOCK_HOLDING | MERGE | MODIFY | MOVE + | MULTIPLY | NOTIFY | NOTIFY_CHANGE | OPEN | OUTPUT | OVERRIDE | PARSE | PERFORM | PRINT + | PRINT_NO_PROMPT | PRINT_PREVIEW | PROCEED | PURGE | RAISE | READ | RECEIVE | REFRESH + | RELEASE | REPLACE | RERUN | RESERVE | RESET | RESUME | RETRY | RETURN | REWRITE | ROLLBACK + | SEARCH | SELECT | SELECT_ALL | SEND | SET | SORT | SORT_MERGE | SORT_ORDER | STDCALL | START + | STEP | STOP | STRING | SUBTRACT | SUPPRESS | TEST | TERMINATE | TRANSFORM | UNLOCK | UNSTRING + | UPDATE | USE | USE_ALT | USE_RETURN | USE_TAB | VALIDATE | VALIDATE_STATUS | WRAP | WRITE + | END_ACCEPT | END_ADD | END_CALL | END_COMPUTE | END_DELETE | END_DISPLAY | END_DIVIDE | END_EVALUATE + | END_IF | END_MULTIPLY | END_PERFORM | END_READ | END_RETURN | END_REWRITE | END_SEARCH | END_START + | END_STRING | END_SUBTRACT | END_UNSTRING | END_WRITE -> + Some (semantic_token lexloc "function" ["defaultLibrary";]) + | _ -> + Some (semantic_token lexloc "keyword" [])) + +let semantic_tbl = Hashtbl.create 16 +let () = List.iteri (fun i elt -> Hashtbl.add semantic_tbl elt i) tokens_types +let index i = Hashtbl.find semantic_tbl i + +let tokens_modifiers_bit_flag = Hashtbl.create 8 +let () = + List.iteri (fun i v -> + Hashtbl.add tokens_modifiers_bit_flag + v (0b1 lsl i)) + tokens_modifiers + +let token_modifiers_flag modifiers = + List.fold_left + (fun acc modifier -> + let modifier_flag = Hashtbl.find tokens_modifiers_bit_flag modifier in + acc lor modifier_flag) + 0b0 + modifiers + +let data_of_semantic_token semantic_token = + let data = Array.make 5 0 in + data.(0) <- semantic_token.line; + data.(1) <- semantic_token.start; + data.(2) <- semantic_token.length; + data.(3) <- index semantic_token.token_type; + data.(4) <- token_modifiers_flag semantic_token.token_modifiers; + data + +let data_of_semantic_tokens semantic_tokens = + let data = Array.make (5 * List.length semantic_tokens) 0 in + ignore @@ List.fold_left + (fun (idx, last_line, last_start) semantic_token -> + let token_data = data_of_semantic_token semantic_token in + let delta_line = token_data.(0) - last_line in + let delta_start = if delta_line = 0 then + token_data.(1) - last_start + else + token_data.(1) + in + data.(5 * idx) <- delta_line; + data.(5 * idx + 1) <- delta_start; + data.(5 * idx + 2) <- token_data.(2); + data.(5 * idx + 3) <- token_data.(3); + data.(5 * idx + 4) <- token_data.(4); + (idx + 1, semantic_token.line, semantic_token.start)) + (0, 0, 0) + semantic_tokens; + data + +let sort_semantic_token first second = (* TODO: use Lexing.position, and then a + comparison on `pos_cnum` only? *) + let cmp = Stdlib.compare first.line second.line in + if cmp = 0 + then Stdlib.compare first.start second.start + else cmp + +let data ~filename tokens ptree : int array = + tokens + |> make_non_ambigious ~filename + |> semantic_visitor ~filename ptree + |> List.fast_sort sort_semantic_token + |> data_of_semantic_tokens diff --git a/src/lsp/cobol_lsp/lsp_server.ml b/src/lsp/cobol_lsp/lsp_server.ml new file mode 100644 index 000000000..8a413e542 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_server.ml @@ -0,0 +1,200 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports +open Lsp.Types + +module DIAGS = Cobol_common.Diagnostics + +module TYPES = struct + + type config = { + project_layout: Lsp_project.layout; + cache_config: Lsp_project_cache.config; + } + + type registry = { (* private *) + projects: Lsp_project.SET.t; + docs: Lsp_document.t URIMap.t; + indirect_diags: Lsp_diagnostics.t URIMap.t; (* diagnostics for other URIs + mentioned by docs in + `docs` *) + config: config; + } + + type state = + | NotInitialized of config (* At startup and until "initialize" request *) + | Initialized of config (* After "initialize" and before "initialized" notif *) + | Running of registry (* After "initialized" and before "shutdown" *) + | ShuttingDown (* From "shuntdown" until "exit" notif *) + | Exit of exit_status (* After "exit" notif *) + + and exit_status = (unit, string) result + + type 'a error = + | InvalidStatus of state + | UnhandledRequest of 'a Lsp.Client_request.t + | UnknownRequest of string + | FormattingError of string + +end +include TYPES + +type t = registry + +(* Code: *) + +let add_project proj r = + let projects = Lsp_project.SET.add proj r.projects in + if projects == r.projects then r else { r with projects } + +let add_or_replace_doc doc r = + let docs = URIMap.add (Lsp_document.uri doc) doc r.docs in + if docs == r.docs then r else { r with docs } + +(** {2 Handling of diagnostics for non-opened documents} *) + +let dispatch_diagnostics (Lsp_document.{ project; diags; _ } as doc) registry = + let uri = Lsp_document.uri doc in + let rootdir = Lsp_project.rootdir project in + let indirect4uri = + if diags <> DIAGS.Set.none + then URIMap.empty (* stick to the new diagnostics *) + else URIMap.filter (fun _ -> URIMap.mem uri) registry.indirect_diags + in + if URIMap.is_empty indirect4uri then begin + let all_diags = + Lsp_diagnostics.translate diags ~uri:(`Main uri) + ~rootdir:(Lsp_project.string_of_rootdir rootdir) + in + (* Note here we may publish diagnostics for non-opened documents. LSP + protocol does not seem to forbid that (but some editors just ignore + those). *) + Lsp_diagnostics.publish all_diags; + { registry with + indirect_diags = + (* Register published diagnostics for the other documents in case they + are opened in the future. *) + URIMap.merge (fun _ _ new_ -> new_) registry.indirect_diags @@ + URIMap.singleton uri (URIMap.remove uri all_diags) } + end else begin (* publish indirect diagnostics for the doc instead *) + let all_diags = + URIMap.fold begin fun _main_uri -> + URIMap.union (fun _ a b -> Some (List.rev_append a b)) + end indirect4uri URIMap.empty + in + Lsp_diagnostics.publish all_diags; + registry + end + +(** {2 Management of per-project caches} *) + +let save_project_caches { config = { cache_config = config; _ }; docs; _ } = + Lsp_project_cache.save ~config docs + +let load_project_cache ~rootdir ({ config = { project_layout = layout; + cache_config = config; _ }; + projects; docs = old_docs; _ } as registry) = + let new_docs = Lsp_project_cache.load ~config ~layout ~rootdir in + let projects = match URIMap.choose_opt new_docs with + | Some (_, Lsp_document.{ project = p; _ }) -> Lsp_project.SET.add p projects + | None -> projects + and docs = URIMap.union (fun _ _old new_ -> Some new_) old_docs new_docs in + { registry with projects; docs } + + +(** {2 Registry management} *) + +let init ~config : registry = + { + config; + projects = Lsp_project.SET.empty; + docs = URIMap.empty; + indirect_diags = URIMap.empty; + } + +let create_or_retrieve_project ~uri registry = + let layout = registry.config.project_layout in + let rootdir = Lsp_project.rootdir_for ~uri ~layout in + try Lsp_project.SET.for_rootdir ~rootdir registry.projects, registry + with Not_found -> + let project = Lsp_project.for_ ~rootdir ~layout in + project, add_project project registry + +let add (DidOpenTextDocumentParams.{ textDocument = { uri; text; _ }; + _ } as doc) ?copybook registry = + (* Try first with a lookup for the project in a cache, and then by + creating/loading the project. *) + let rec aux ~try_cache registry = + match URIMap.find_opt uri registry.docs with + (* When opening, we need to check that the text we already have (in cache) + matches what the client gives us. *) + | Some doc when String.equal (Lsp.Text_document.text doc.textdoc) text -> + dispatch_diagnostics doc registry + | None | Some _ when try_cache -> + let registry = + let layout = registry.config.project_layout in + let rootdir = Lsp_project.rootdir_for ~uri ~layout in + if Lsp_project.SET.mem_rootdir ~rootdir registry.projects + then registry + else load_project_cache ~rootdir registry + in + aux ~try_cache:false registry (* try again without the cache *) + | None | Some _ -> + let project, registry = create_or_retrieve_project ~uri registry in + let doc = Lsp_document.load ~project ?copybook doc in + let registry = dispatch_diagnostics doc registry in + add_or_replace_doc doc registry + in + aux ~try_cache:true registry + +let update DidChangeTextDocumentParams.{ textDocument = { uri; _ }; + contentChanges; _ } registry = + try + let doc = URIMap.find uri registry.docs in + let doc = Lsp_document.update doc contentChanges in + let registry = dispatch_diagnostics doc registry in + add_or_replace_doc doc registry + with Not_found -> + Pretty.failwith "Document@ %s@ was@ not@ opened@ before@ changes" + (DocumentUri.to_string uri) + +let remove DidCloseTextDocumentParams.{ textDocument = { uri } } registry = + { registry with docs = URIMap.remove uri registry.docs } + +(** Raises {!Not_found} if the document is not currently opened. *) +let find_document TextDocumentIdentifier.{ uri; _ } { docs; _ } = + URIMap.find uri docs + +(** {2 Miscellaneous} *) + +let jsonrpc_of_error error method_ = + let (code: Jsonrpc.Response.Error.Code.t), message = match error with + | InvalidStatus NotInitialized _ -> + ServerNotInitialized, "Expected 'initialize' request" + | InvalidStatus Initialized _ -> + InvalidRequest, "Unexpected request during initialization" + | InvalidStatus ShuttingDown -> + InvalidRequest, "Unexpected request while shutting down" + | InvalidStatus Exit _ -> + InvalidRequest, "Unexpected request while quitting" + | InvalidStatus Running _ -> + InvalidRequest, "Unexpected request while running" + | UnhandledRequest _ -> + RequestFailed, Fmt.str "Unhandled request: %s" method_ + | UnknownRequest method_ -> + MethodNotFound, Fmt.str "Unknown request method: %s" method_ + | FormattingError msg -> + RequestFailed, Fmt.str "Formatting request error: %s" msg + in + Jsonrpc.Response.Error.make ~code ~message () diff --git a/src/lsp/cobol_lsp/lsp_server.mli b/src/lsp/cobol_lsp/lsp_server.mli new file mode 100644 index 000000000..c57115aa7 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_server.mli @@ -0,0 +1,81 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Lsp_imports + +module TYPES: sig + + type config = { + project_layout: Lsp_project.layout; + cache_config: Lsp_project_cache.config; + } + + type registry = private { + projects: Lsp_project.SET.t; + docs: Lsp_document.t URIMap.t; + indirect_diags: Lsp_diagnostics.t URIMap.t; (* diagnostics for other URIs + mentioned by docs in + `docs` *) + config: config; + } + + type state = + | NotInitialized of config (* At startup and until "initialize" request *) + | Initialized of config (* After "initialize" and before "initialized" notif *) + | Running of registry (* After "initialized" and before "shutdown" *) + | ShuttingDown (* From "shuntdown" until "exit" notif *) + | Exit of exit_status (* After "exit" notif *) + + and exit_status = (unit, string) result + + type 'a error = + | InvalidStatus of state + | UnhandledRequest of 'a Lsp.Client_request.t + | UnknownRequest of string + | FormattingError of string + +end +include module type of TYPES + with type config = TYPES.config + and type registry = TYPES.registry + and type state = TYPES.state + and type exit_status = TYPES.exit_status + and type 'a error = 'a TYPES.error + +type t = registry (* alias *) + +val init + : config:config + -> t + +(** When given, [copybook] indicates whether the document is a copybook (in + which case it is not parsed directly as a normal program). When absent, + copybook detection is performed via project configuration (see + {!Lsp_project.detect_copybook}). *) +val add + : Lsp.Types.DidOpenTextDocumentParams.t -> ?copybook: bool -> t -> t + +val update + : Lsp.Types.DidChangeTextDocumentParams.t -> t -> t + +val remove + : Lsp.Types.DidCloseTextDocumentParams.t -> t -> t + +val find_document + : Lsp.Types.TextDocumentIdentifier.t -> t -> Lsp_document.t + +val jsonrpc_of_error + : 'a error -> string -> Jsonrpc.Response.Error.t + +val save_project_caches + : t -> unit diff --git a/src/lsp/cobol_lsp/lsp_server_loop.ml b/src/lsp/cobol_lsp/lsp_server_loop.ml new file mode 100644 index 000000000..9e39aea55 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_server_loop.ml @@ -0,0 +1,68 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** LSP server's main I/O-driven loop *) + +open Ez_file.V1 +open Ez_file.V1.EzFile.OP + +(** [config ~project_config_filename ~relative_work_dirname] creates an LSP + configuration structure for identifying and managing projects. + + - [project_config_filename] is the names of the TOML file that is to be + found at the root of each project's directory tree; + + - [relative_work_dirname] is the name of the directory where the LSP should + put its working files (caches, etc). *) +let config ~project_config_filename ~relative_work_dirname = + let invalid_dir reason = + Fmt.invalid_arg + ("relative_work_dirname: "^^reason^^" (got `%s')") relative_work_dirname + in + if relative_work_dirname = "" + then invalid_dir "invalid direcory name"; + if EzFile.is_absolute relative_work_dirname + then invalid_dir "relative direcory name expected"; + Lsp_server.{ + cache_config = { + cache_relative_filename = relative_work_dirname // "lsp-cache"; + cache_verbose = true; + }; + project_layout = { + project_config_filename; + }; + } + +(** Start the lsp server, listening and responding on stdin and stdout. This is + blocking (driven by standard input), and shutdown is triggered by a client + request. Returns [Ok ()] if the server ran and shut down properly, or + [Error error_message] otherwise. *) +let run ~config = + let process_msg = function + | Jsonrpc.Packet.Notification n -> + Lsp_notif.handle n + | Request r -> + Lsp_request.handle r + | _ -> + Fun.id + in + let rec loop status = + let status = match Lsp_io.read_message () with + | Error e -> Jsonrpc.Response.Error.raise e + | Ok m -> process_msg m status + in + match status with + | Exit code -> code + | _ -> loop status + in + loop (NotInitialized config) diff --git a/src/lsp/cobol_lsp/lsp_server_loop.mli b/src/lsp/cobol_lsp/lsp_server_loop.mli new file mode 100644 index 000000000..70a452b2f --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_server_loop.mli @@ -0,0 +1,21 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val config + : project_config_filename: string + -> relative_work_dirname: string + -> Lsp_server.config + +val run + : config: Lsp_server.config + -> Lsp_server.exit_status diff --git a/src/lsp/cobol_lsp/lsp_utils.ml b/src/lsp/cobol_lsp/lsp_utils.ml new file mode 100644 index 000000000..32de99c7d --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_utils.ml @@ -0,0 +1,44 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file.V1 + +(** [relative_path uri absolute_path] returns the relative path of [uri] {i + w.r.t} [absolute_path] if [absolute_path] is a prefix of [uri], and raises + {!Invalid_argument} otherwise. *) +let relative_path ~uri absolute_path = + let path = Lsp.Uri.to_path uri in + match EzString.chop_prefix ~prefix:absolute_path path with + | Some "" -> "." + | Some path when path.[0] = FileOS.dir_separator -> EzString.after path 0 + | Some path -> path + | None -> Fmt.invalid_arg "%s is not contained within %s" path absolute_path + +let is_file path = EzFile.exists path && not (EzFile.is_directory path) + +let read_from path f = + let ic = open_in_bin path in + match f ic with + | v -> close_in ic; v + | exception exn -> close_in ic; raise exn + +let write_to path f = + let oc = open_out_bin path in + try + f oc; + close_out oc; + Pretty.error "Wrote %s@." path + with e -> + Pretty.error "Error when writing %s (removing): %a@." path Fmt.exn e; + EzFile.remove path; + raise e diff --git a/src/lsp/cobol_lsp/lsp_utils.mli b/src/lsp/cobol_lsp/lsp_utils.mli new file mode 100644 index 000000000..4fd275ef7 --- /dev/null +++ b/src/lsp/cobol_lsp/lsp_utils.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val relative_path: uri:Lsp.Uri.t -> string -> string +val is_file: string -> bool +val read_from: string -> (in_channel -> 'a) -> 'a +val write_to: string -> (out_channel -> unit) -> unit diff --git a/src/lsp/cobol_lsp/package.toml b/src/lsp/cobol_lsp/package.toml new file mode 100644 index 000000000..621084821 --- /dev/null +++ b/src/lsp/cobol_lsp/package.toml @@ -0,0 +1,83 @@ + +# name of package +name = "cobol_lsp" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_common = "version" +cobol_config = "version" +cobol_data = "version" +cobol_indent = "version" +cobol_parser = "version" +cobol_typeck = "version" +jsonrpc = ">=1.15" +lsp = ">=1.15 <1.16" +pretty = "version" +toml = "7.1.0" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/vscode-debugprotocol/version.mlt b/src/lsp/cobol_lsp/version.mlt similarity index 100% rename from src/vscode-debugprotocol/version.mlt rename to src/lsp/cobol_lsp/version.mlt diff --git a/src/lsp/cobol_parser/README.md b/src/lsp/cobol_parser/README.md new file mode 100644 index 000000000..b619ca6e5 --- /dev/null +++ b/src/lsp/cobol_parser/README.md @@ -0,0 +1,6 @@ +# Cobol_parser package + +This package contains all the parsing logic and grammar definitions, as well as some Menhir extensions +to parse COBOL. + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_parser/cobol_parser.ml b/src/lsp/cobol_parser/cobol_parser.ml new file mode 100644 index 000000000..f1ed7d7ea --- /dev/null +++ b/src/lsp/cobol_parser/cobol_parser.ml @@ -0,0 +1,82 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** {1 Exported modules} *) + +(** Parse tree *) +module PTree = PTree +module PTree_visitor = PTree_visitor + +(** Options to tune the parser engine *) +include Parser_options + +type ('a, 'm) parsed_result = ('a, 'm) Parser_engine.parsed_result = + { + parsed_input: Cobol_preproc.input; + parsed_diags: Cobol_common.Diagnostics.Set.t; + parsed_output: ('a, 'm) Parser_options.output; + } + +type 'm parsed_compilation_group = + (PTree.compilation_group option, 'm) parsed_result + +(** {1 Exported modules} *) +(*TODO: remove these extra modules once the parser provides the proper tokens.*) +module Grammar_contexts = Grammar_contexts +module Grammar_tokens = Grammar_tokens +module Text_keywords = Text_keywords + +(** {1 Exported functions} *) + +type 'x source_handling = ?source_format:Cobol_config.source_format_spec -> 'x + +let parse_simple: _ source_handling = Parser_engine.parse_simple +let parse_with_tokens: _ source_handling = Parser_engine.parse_with_tokens +let parsed_tokens = Parser_engine.parsed_tokens +let preproc_rev_log = Parser_engine.preproc_rev_log + +(* --- *) + +(** {1 Modules and functions exported for testing purposes} + + Signatures of modules below may change unexpectedly. *) + +module INTERNAL = struct + + (** {2 COBOL tokens} *) + module Tokens = Grammar_tokens + + let pp_token = Text_tokenizer.pp_token + let pp_tokens = Text_tokenizer.pp_tokens + + (** {2 COBOL grammar} *) + module Grammar (* : Grammar_sig.S *) = Grammar + + (** {2 Parser with dummy source locations, that can be fed directly with a + list of tokens} *) + module Dummy = struct + module Tags: Cobol_ast.Helpers.TAGS = struct + let loc = Cobol_common.Srcloc.raw Lexing.(dummy_pos, dummy_pos) + end + + let parse_as item toks = + let toks = ref toks + and dummy_lexer = Lexing.from_string ~with_positions:false "" in + item begin fun _ -> match !toks () with + | Seq.Nil -> Grammar_tokens.EOF + | Cons (x, tl) -> toks := tl; x + end dummy_lexer + + let parse_list_as parse lx = parse_as parse (List.to_seq lx) + end +end diff --git a/src/lsp/cobol_parser/context.ml b/src/lsp/cobol_parser/context.ml new file mode 100644 index 000000000..4da82f4a6 --- /dev/null +++ b/src/lsp/cobol_parser/context.ml @@ -0,0 +1,87 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** {1 Context management} + + This module defines syntactical contexts that are used to enable keywords + that are context sensitive {i w.r.t} grammar rules. Such rules are + annotated using [[@context]] attribules, that describe a context which is: + + - entered {e after} the {e first item} on the rules' right-hand side has + been observed. + NOTE: for now this item must be a terminal symbol; + + - exited whenever the annotated rule is reduced. +*) + +(** {2 Context types} + + We concretely represent a context [ctx] as the set of keywords that are + sensitive to [ctx]. +*) + +module TH = Text_lexer.TokenHandles + +type context = TH.t +let pp_context ppf c = + Pretty.list ~fopen:"{@[" ~fclose:"@]}" ~fempty:"{}" begin fun ppf h -> + Pretty.string ppf (Text_lexer.show_token_of_handle h) + end ppf (TH.elements c) + +type t = context + +(** {2 Context stack} *) + +(** The type context stacks as managed by the parser. *) +type stack = entry list + +(** As the set of context-sensitive keywords may not by disjoint between + contexts, each element of the stack maintains the difference that a context + [ctx] brings {i w.r.t} all contexts that were inserted in the stack before + [ctx]. *) +and entry = + { + ctx: context; + diff: tokens_diff; + } +and tokens_diff = TH.t + +(** {3 Usual operations on context stacks} *) + +let empty_stack: stack = [] + +let push: context -> stack -> stack = fun ctx -> function + | [] -> [ { ctx; diff = ctx } ] + | { diff = top; _ } :: _ as t -> { ctx; diff = TH.diff ctx top } :: t + +let top: stack -> context option = function + | { ctx; _ } :: _ -> Some ctx + | [] -> None + +(** {3 Context-specific operations} *) + +(** Retrieve the difference between the hidden part of the stack ({i i.e} all + its elements, minus the top one), and the top element of the stack (if any), + in terms of a set of context-sensitive keywords; returns an empty set if the + stack is empty. *) +let top_tokens: stack -> TH.t = function + | [] -> TH.empty + | { diff; _ } :: _ -> diff + +(** [pop stack] pops the top element [ctx] from [stack]. Retrieves the + difference between the hidden part of the stack [stack] ({i i.e} all its + elements, minus [ctx]), and [ctx], in terms of a set of context-sensitive + keywords. Raises {!Invalid_argument} if the stack is empty. *) +let pop: stack -> stack * TH.t = function + | [] -> Pretty.invalid_arg "Unable to pop on an empty context stack" + | { diff; _ } :: tl -> tl, diff diff --git a/src/lsp/cobol_parser/context.mli b/src/lsp/cobol_parser/context.mli new file mode 100644 index 000000000..5d6f9c4d9 --- /dev/null +++ b/src/lsp/cobol_parser/context.mli @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** {2 Context(s)} *) + +type context = Grammar_contexts.t +val pp_context: context Pretty.printer + +type t = context +(** {2 Context stack} *) + +type stack + +(** {3 Usual operations on context stacks} *) + +val empty_stack: stack +val push: context -> stack -> stack +val top: stack -> context option + +(** {3 Context-specific operations} *) + +val top_tokens: stack -> Text_lexer.TokenHandles.t +val pop: stack -> stack * Text_lexer.TokenHandles.t diff --git a/src/lsp/cobol_parser/context/dune b/src/lsp/cobol_parser/context/dune new file mode 100644 index 000000000..f9ef08185 --- /dev/null +++ b/src/lsp/cobol_parser/context/dune @@ -0,0 +1,9 @@ +(executable + (name gen_context) + (modules Gen_context) + (libraries unix fmt menhirSdk)) + +(executable + (name gen_contexts) + (modules Gen_contexts) + (libraries unix fmt menhirSdk)) diff --git a/src/lsp/cobol_parser/context/gen_context.ml b/src/lsp/cobol_parser/context/gen_context.ml new file mode 100644 index 000000000..44c27fa39 --- /dev/null +++ b/src/lsp/cobol_parser/context/gen_context.ml @@ -0,0 +1,109 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let name = ref "" + +let usage () = + Printf.eprintf "Usage: %s file.cmly\n" Sys.argv.(0); + exit 1 + +let () = + for i = 1 to Array.length Sys.argv - 1 do + if !name = "" + then name := Sys.argv.(i) + else usage () + done; + if !name = "" + then usage () + +(* --- *) + +include MenhirSdk.Cmly_read.Read (struct let filename = !name end) + +let pp_pos ppf r = + let Lexing.({ pos_lnum = l1; pos_bol = b1; pos_cnum = c1; pos_fname; _ }, + { pos_lnum = l2; pos_bol = b2; pos_cnum = c2; _ }) + = Range.(startp r, endp r) in + Fmt.pf ppf "%s:%a" pos_fname Fmt.text_loc ((l1, c1 - b1), (l2, c2 - b2)) + +let context attrs = + List.find_opt (Attribute.has_label "context") attrs |> + Option.map (fun a -> Attribute.payload a, Attribute.position a) + +let nonterminal_context n : (string * Range.t) option = + match Nonterminal.kind n with + | `REGULAR -> context (Nonterminal.attributes n) + | `START -> None + +let emit_prelude ppf = + List.iter begin fun a -> + if Attribute.has_label "header" a || + Attribute.has_label "context.header" a then + Format.fprintf ppf "%s\n" (Attribute.payload a) + end Grammar.attributes + +let emit_nonterminal_contexts ppf = + Fmt.pf ppf "\ + let nonterminal_context: type k. k nonterminal -> _ option = function\n"; + Nonterminal.iter begin fun n -> match nonterminal_context n with + | Some (s, pos) -> + if Nonterminal.nullable n then + Fmt.epr "%a:@\n\ + @[<2>** Warning:@ context@ `%s'@ on@ nullable@ \ + non-terminal@]@." pp_pos pos s; + Fmt.pf ppf " | N_%s -> Some %s\n" (Nonterminal.name n) s + | None -> () + end; + Fmt.pf ppf "\ + \ | _ -> None\n" + +let pp_contexts = Fmt.(list ~sep:(any ";@ ") string) + +let emit_contexts_mapping ppf = + Fmt.pf ppf "\ + let contexts_for_state_num: int -> _ list = function\n"; + Lr1.iter begin fun s -> + let contexts = + List.filter_map begin fun (prod, i) -> + if i == 1 + then Option.map fst @@ nonterminal_context (Production.lhs prod) + else None + end (Lr0.items (Lr1.lr0 s)) + in + match List.sort_uniq (String.compare) contexts with + | [] -> () (* skip *) + | ctxs -> Fmt.pf ppf " | %d -> [%a]\n" (Lr1.to_int s) pp_contexts ctxs + end; + Fmt.pf ppf "\ + \ | _ -> []\ + \n\ + \nlet contexts: type k. k lr1state -> _ list = fun s ->\ + \n contexts_for_state_num (number s)\n" + +let emit ppf = + Fmt.pf ppf + "(* Caution: this file was automatically generated from %s; do not edit *)\ + @\nopen %s\ + @\nopen MenhirInterpreter\ + @\n%t\ + @\n%t\ + @\n%t\ + @\n" + !name + (String.capitalize_ascii (Filename.basename Grammar.basename)) + emit_prelude + emit_nonterminal_contexts + emit_contexts_mapping + +let () = + emit Fmt.stdout diff --git a/src/lsp/cobol_parser/context/gen_contexts.ml b/src/lsp/cobol_parser/context/gen_contexts.ml new file mode 100644 index 000000000..d9173b687 --- /dev/null +++ b/src/lsp/cobol_parser/context/gen_contexts.ml @@ -0,0 +1,153 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let name = ref "" +let external_tokens = ref "" + +let usage = Fmt.str "Usage: %s [OPTIONS] file.cmly" Sys.argv.(0) + +let anon str = + if !name = "" then + name := str + else + raise @@ Arg.Bad usage + +let () = + Arg.parse + Arg.[ + ("--external-tokens", Set_string external_tokens, + " Import token type definitions from "); + ] + anon usage + +include MenhirSdk.Cmly_read.Read (struct let filename = !name end) + +let tokens_module = + match !external_tokens with + | "" -> String.capitalize_ascii @@ Filename.basename Grammar.basename + | s -> s + +let all_ctxts = ref [] + +let context_list str = + String.split_on_char ',' str |> + List.filter_map (fun ctxt -> + let ctxt = String.trim ctxt in + if ctxt <> "" then + Some ctxt + else + None) + +let has_contexts attrs = + List.find_opt (Attribute.has_label "contexts") attrs |> Option.is_some + +let contexts attrs = + List.find_opt (Attribute.has_label "contexts") attrs |> + Option.fold ~none:[] ~some:(fun attr -> context_list @@ Attribute.payload attr) + +let emit_contexts ppf t = + match Terminal.kind t with + | `ERROR | `EOF | `PSEUDO -> + () + | `REGULAR -> + let attrs = Terminal.attributes t in + if has_contexts attrs then + let contexts = contexts (Terminal.attributes t) in + Fmt.pf ppf "%s,@ [%a];@\n" + (Terminal.name t) + Fmt.(list ~sep:(any ";@ ") string) contexts + +let emit_specs ppf = + Fmt.pf ppf "@[<2>let specs = %s.[@\n" tokens_module; + (*So they are in alphabetical order*) + let terminals = ref [] in + Terminal.iter (fun t -> terminals := t :: !terminals); + List.iter (emit_contexts ppf) !terminals; + Fmt.pf ppf "@]]@\nin@\n" + +let emit_empty_record ppf = + Fmt.(list ~sep:(any ";@\n") (fun ppf c -> Fmt.pf ppf " %s = empty" c) ppf) !all_ctxts + +let emit_ctxt_funs ppf = + Fmt.(list + ~sep:(any "@\n") + (fun ppf c -> + Fmt.pf ppf "let %s t c = { c with %s = add t c.%s } in" c c c) + ppf) + !all_ctxts + +let emit_fold ppf = + Fmt.pf ppf "List.fold_left (fun (acc, cstoks, unimpl) (t, add_contexts) ->@\n\ + \ let h = Text_lexer.handle_of_token t in@\n\ + \ List.fold_left (fun acc f -> f h acc) acc add_contexts,@\n\ + \ TH.add h cstoks,@\n\ + \ if add_contexts = [] then TH.add h unimpl else unimpl)@\n\ + (empty, TH.empty, TH.empty) specs" + +let emit_tokens_contexts ppf = + Fmt.pf ppf "let all, sensitive_tokens, sensitive_tokens_unimplemented =@\n\ + @[<2> let open TH in@\n\ + let empty =@\n\ + \ {@\n\ + %t;@\n\ + \ }@\n\ + in@\n\ + %t@\n\ + %t\ + %t@]" + emit_empty_record + emit_ctxt_funs + emit_specs + emit_fold + +let emit_context_type ppf = + let ctxts = ref [] in + Terminal.iter (fun t -> + let attrs = Terminal.attributes t in + if has_contexts attrs then + begin + ctxts := (contexts attrs) @ !ctxts + end); + let ctxts = List.sort_uniq (String.compare) !ctxts in + all_ctxts := ctxts; + Fmt.(list ~sep:(any ";@\n") (fun ppf n -> Fmt.pf ppf " %s: t" n) ppf) ctxts + +let emit_prelude ppf = + Fmt.pf ppf "module TH = Text_lexer.TokenHandles@\n\ + type context = TH.t@\n@\n\ + type t = context@\n\ + type contexts =@\n\ + \ {@\n\ + %t;@\n\ + \ }@\n" + emit_context_type + +let emit_context_values ppf = + List.iter (fun ctxt -> + Fmt.pf ppf "let %s = all.%s@\n" ctxt ctxt) + !all_ctxts + +let emit ppf = + Fmt.pf ppf + "(* Caution this file was automatically generated from %s; do not edit *)@\n\ + %t@\n\ + %t@\n@\n\ + %t@\n" + !name + emit_prelude + emit_tokens_contexts + emit_context_values + +let () = + emit Fmt.stdout + diff --git a/src/lsp/cobol_parser/contexts.ml b/src/lsp/cobol_parser/contexts.ml new file mode 100644 index 000000000..ab77caf15 --- /dev/null +++ b/src/lsp/cobol_parser/contexts.ml @@ -0,0 +1,55 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module type T = sig + type t + val accept_stmt: t + val allocate_stmt: t + val alphabet_clause: t + val arithmetic_clause: t + val class_specifier: t + val column_clause: t + val constant: t + val currency_clause: t + val default_clause: t + val dynlen_struct_clause: t + val erase_clause: t + val exit_stmt: t + val factory_paragraph: t + val float_binary_clause: t + val float_decimal_clause: t + val function_specifier: t + val interface_specifier: t + val intermediate_rounding_clause: t + val line_clause: t + val lock_mode_clause: t + val lock_on_phrase: t + val object_computer_paragraph: t + val object_paragraph: t + val occurs_clause: t + val options_paragraph: t + val program_id_paragraph: t + val read_stmt: t + val resume_stmt: t + val retry_phrase: t + val rounded_phrase: t + val screen_descr_entry: t + val set_attribute_stmt: t + val set_stmt: t + val sharing_clause: t + val sharing_phrase: t + val stop_stmt: t + val typedef_clause: t + val usage_clause: t + val validate_status_clause: t +end diff --git a/src/lsp/cobol_parser/dune b/src/lsp/cobol_parser/dune new file mode 100644 index 000000000..1b0e14325 --- /dev/null +++ b/src/lsp/cobol_parser/dune @@ -0,0 +1,93 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_parser) + (public_name cobol_parser) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ppx_deriving menhirLib ez_file ebcdic_lib cobol_preproc cobol_common cobol_ast str) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show)) + + ) + +(ocamllex text_categorizer) + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_parser)) + +; use field 'dune-trailer' to add more stuff here +(menhir (modules grammar_tokens grammar_common grammar) + (merge_into grammar) + (flags --inspection --cmly --table --strict + + --external-tokens Grammar_tokens + --unused-tokens)) + + +(menhir (modules grammar_tokens) + (flags --inspection --table --only-tokens)) + +(rule + (targets text_keywords.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./keywords/gen_keywords.exe} %{deps} + --external-tokens Grammar_tokens)))) + +(rule + (targets grammar_post_actions.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./post/gen_post_actions.exe} %{deps})))) + +(rule + (targets grammar_recover.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./recover/gen_recover.exe} %{deps})))) + +(rule + (targets grammar_contexts.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./context/gen_contexts.exe} %{deps} + --external-tokens Grammar_tokens)))) + +(rule + (targets grammar_context.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./context/gen_context.exe} %{deps})))) + +(rule + (targets grammar_printer.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./printer/gen_printer.exe} %{deps})))) + diff --git a/src/lsp/cobol_parser/grammar.mly b/src/lsp/cobol_parser/grammar.mly new file mode 100644 index 000000000..15e154143 --- /dev/null +++ b/src/lsp/cobol_parser/grammar.mly @@ -0,0 +1,3962 @@ +%{ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +open PTree +open Grammar_utils +open Cobol_ast +open Cobol_common.Srcloc.INFIX + +let split_last l = + List.(let rl = rev l in hd rl, rev (tl rl)) + +let with_loc token location_limits = + token &@ Grammar_utils.Overlay_manager.join_limits location_limits + +let dual_handler_none = + { dual_handler_pos = []; dual_handler_neg = [] } +%} + +(* Tokens are listed in `grammar_tokens.mly' *) +%[@printer.header open Grammar_tokens] +%[@context.header open Grammar_contexts] + +(* --- Post-actions --- *) + +(* Post-actions are functions with pre-defined argument and return types, that + can be executed whenever a production is reduced. Post-actions always + receive as first argument the semantic value that is produced. + + These actions may be specified using attributes attached to a rule as a whole + (in which case the action is executed whenever any production defined within + the rule is reduced). Alternatively, a post-action may be attached to a + single production by means of an attribute to the last item of its producers. + When both attributes are given, the latter takes precedence. *) + +(* Parameter module specific to post-actions *) +%[@post.parameter Config: Cobol_config.T] + +(* Tag declaration for post-actions. + + For now we only define a single kind of post-actions, that receives an + optional source code location in addition to the semantic value (which is + implicit in the declaration below), and returns a diagnostics result. With + this definition, grammar attributes "[@post.diagnostic ...]" may be used to + create diagnostics based on the result of configuration feature + verifications. *) +%[@post.tag diagnostic loc:Cobol_common.Srcloc.srcloc option -> + unit Cobol_common.Diagnostics.in_result] + +%[@post.tag special_names Cobol_ast.special_names_clause] + +%[@post.tag pending string] + +(* --- Recovery helpers --- *) + +%[@recovery.header + open Cobol_common.Srcloc.INFIX + + let dummy_loc = + Grammar_utils.Overlay_manager.(join_limits (dummy_limit, dummy_limit)) + + let dummy_name = "_" &@ dummy_loc + + let dummy_qualname: Cobol_ast.qualname = + Cobol_ast.Name dummy_name + + let dummy_qualident = + Cobol_ast.{ ident_name = dummy_qualname; + ident_refmod = None; + ident_subscripts = [] } + + let dummy_ident = + Cobol_ast.QualIdent dummy_qualident + + let dummy_expr = + Cobol_ast.Atom (Fig Zero) + + let dummy_picture = + PTree.{ picture = "X" &@ dummy_loc; + picture_locale = None; + picture_depending = None } +] + +%nonassoc lowest +%nonassoc ELSE + +(* Set precedence of statements to be higher than imperative statement *) +(* This helps resolve conflicts in lists of statements, by prefering shift *) +%nonassoc ACCEPT +%nonassoc ADD +%nonassoc ALLOCATE +%nonassoc ALTER +%nonassoc CALL +%nonassoc CANCEL +%nonassoc CLOSE +%nonassoc COMPUTE +%nonassoc CONTINUE +%nonassoc DELETE +%nonassoc DISABLE +%nonassoc DISPLAY +%nonassoc DIVIDE +%nonassoc ENABLE +%nonassoc ENTER +%nonassoc EVALUATE +%nonassoc EXIT +%nonassoc FREE +%nonassoc GENERATE +%nonassoc GO +%nonassoc GOBACK +%nonassoc IF +%nonassoc INITIALIZE +%nonassoc INITIATE +%nonassoc INSPECT +%nonassoc INVOKE +%nonassoc MERGE +%nonassoc MOVE +%nonassoc MULTIPLY +%nonassoc OPEN +%nonassoc PERFORM +%nonassoc PURGE +%nonassoc RAISE +%nonassoc READ +%nonassoc RECEIVE +%nonassoc RELEASE +%nonassoc RESUME +%nonassoc RETURN +%nonassoc REWRITE +%nonassoc SEARCH +%nonassoc SEND +%nonassoc SET +%nonassoc SORT +%nonassoc START +%nonassoc STOP +%nonassoc STRING +%nonassoc SUBTRACT +%nonassoc SUPPRESS +%nonassoc TERMINATE +%nonassoc TRANSFORM +%nonassoc UNLOCK +%nonassoc UNSTRING +%nonassoc VALIDATE +%nonassoc WRITE + +(* Precedence for empty terminators *) +%nonassoc no_term + +(* Precedence higher than no_term so that we can keep shifting *) +%nonassoc EXCEPTION ON_EXCEPTION NOT_ON_EXCEPTION ON_SIZE_ERROR NOT_ON_SIZE_ERROR OVERFLOW ON_OVERFLOW NOT_ON_OVERFLOW INVALID_KEY NOT_INVALID_KEY AT_END NOT_AT_END AT_EOP END_OF_PAGE NOT_AT_EOP EOP DATA WITH_DATA (*NO_DATA*) END ON NEXT_PAGE + +(* Set precedence of terminators to be higher than the absence of terminator *) +(* Allows to solve conflicts with nested terminated-statements *) +%nonassoc END_ACCEPT +%nonassoc END_ADD +%nonassoc END_CALL +%nonassoc END_COMPUTE +%nonassoc END_DELETE +%nonassoc END_DISPLAY +%nonassoc END_DIVIDE +%nonassoc END_EVALUATE +%nonassoc END_IF +%nonassoc END_MULTIPLY +%nonassoc END_READ +%nonassoc END_RECEIVE +%nonassoc END_RETURN +%nonassoc END_REWRITE +%nonassoc END_SEARCH +%nonassoc END_START +%nonassoc END_STRING +%nonassoc END_SUBTRACT +%nonassoc END_UNSTRING +%nonassoc END_WRITE +%nonassoc below_LINES +%nonassoc LINES +%nonassoc WORD TO FROM WHEN USING VALUE OPTIONAL SUM INVALID +%nonassoc BELL BLINK HIGHLIGHT LOWLIGHT REVERSE_VIDEO UNDERLINE +%nonassoc FOREGROUND_COLOR BACKGROUND_COLOR + +%left OR +%left AND +%right AMPERSAND +%right DOUBLE_COLON AS + +%nonassoc OF IN +%nonassoc below_RPAR +%nonassoc RPAR +%nonassoc LPAR +%nonassoc PLUS_SIGN +%nonassoc DASH_SIGN + +(* Symbol types *) + +%type <(statement, string) result> imperative_statement + +(* Entry points *) + +%start compilation_group +%start standalone_condition + +%% + +(* --------------------- DEDICATED UTILITIES -------------------------------- *) + +let nel [@recovery []] [@symbol ""] (X) := + | x = X; { [ x ] } %prec lowest + | x = X; l = nel(X); { x :: l } + +let rnel [@recovery []] [@symbol ""] (X) := ~ = nel (X); < > (* alias *) + +let loc_result (X) == + | res = loc (X); { Cobol_common.Srcloc.lift_result res } + +let loc (X) == + | x = X; { x &@ Grammar_utils.Overlay_manager.join_limits $sloc } + +let ioloc (X) == + | {None} + | ~ = loc(X); + +(* --------------------- COMPILATION GROUPS AND UNITS ---------------------- *) + +let compilation_group := + | option(control_division); + ul = ll(loc(compilation_unit)); + pdo = loc(program_definition_no_end)?; EOF; + { match pdo with + | None -> ul + | Some pd -> ul @ [((Program ~&pd): compilation_unit) &@<- pd] } + +(* --- CONTROL DIVISION --- *) + +let control_division [@post.diagnostic fun _ -> Config.control_division#verify] := + | CONTROL; DIVISION; "."; + option(default_section) + +let default_section := + | DEFAULT; SECTION; "."; default_section_clauses + +let default_section_clauses := + | option(mr(option(default_accept_clause); + option(default_display_clause); + ".")) + +let default_accept_clause := + | ACCEPT; IS?; word_or_terminal + +let default_display_clause := + | DISPLAY; IS?; word_or_terminal + +let word_or_terminal [@symbol ""] := + | WORD; {} + | TERMINAL; {} + +(* --- COMPILATION UNIT --- *) + +let compilation_unit := + | ~ = program_prototype ; + | ~ = program_definition ; + | ~ = function_unit ; + | ~ = class_definition ; + | ~ = interface_definition ; + + + +program_definition [@cost 0]: + | pd = program_definition_no_end + pdl = loc(program_definition)* (* COB2002: PROCEDURE DIVISION must be present *) + END PROGRAM ep = name "." + { match pd.program_level with + | ProgramDefinition { kind; + has_identification_division; + informational_paragraphs; + nested_programs = [] } -> + { pd with + program_level = ProgramDefinition { kind; + has_identification_division; + informational_paragraphs; + nested_programs = pdl }; + program_end_name = Some ep } + | _ -> failwith "Cannot happen as per the grammar." } + +program_definition_no_end: + | id = bo(identification_division) (* COB85: mandatory *) + pid = program_id_paragraph + ipo = informational_paragraphs (* Allowed in nested programs ? *) + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + ddo = ro(loc(data_division)) + pdo = ro(loc(program_procedure_division)) + { let program_name, program_as, kind = pid in + { program_name; + program_as; + program_level = ProgramDefinition { kind; + has_identification_division = id; + informational_paragraphs = ipo; + nested_programs = [] }; + program_options = opo; + program_env = edo; + program_data = ddo; + program_proc = pdo; + program_end_name = None } } +(* Note: END PROGRAM is not mandatory on last top-level program + if it does not contain nested programs (it may be used though) *) + +program_prototype [@cost 999]: + | bo(identification_division) (* Note: bo instead of ? to avoid conflict *) + pid = program_prototype_id_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + ddo = ro(loc(data_division)) + pdo = ro(loc(procedure_division)) + END PROGRAM ep = name "." + { let program_name, program_as = pid in + { program_name; + program_as; + program_level = ProgramPrototype; + program_options = opo; + program_env = edo; + program_data = ddo; + program_proc = pdo; + program_end_name = Some ep } } + +function_unit [@cost 999]: + | ro(identification_division) + fid = function_id_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + ddo = ro(loc(data_division)) + pdo = ro(procedure_division) + END FUNCTION ef = name "." + { let name, as_, is_proto = fid in + { function_name = name; + function_as = as_; + function_is_proto = is_proto; + function_options = opo; + function_env = edo; + function_data = ddo; + function_proc = pdo; + function_end_name = ef } } (* TODO: shoudn't we just check ef == name? *) + +class_definition [@cost 999]: + | ro(identification_division) + cid = class_id_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + fdo = io(factory_definition) (* Note: inline to avoid conflict *) + ido = ro(instance_definition) + END CLASS ec = name "." + { let class_name, class_as, class_final, + class_inherits, class_usings = cid in + { class_name; + class_as; + class_final; + class_inherits; + class_usings; + class_options = opo; + class_env = edo; + class_factory = fdo; + class_instance = ido; + class_end_name = ec } } + +factory_definition: + | ro(identification_division) + fp = factory_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + ddo = ro(loc(data_division)) + pdo = ro(object_procedure_division) + END FACTORY "." + { { factory_implements = fp; + factory_options = opo; + factory_env = edo; + factory_data = ddo; + factory_methods = pdo } } + +instance_definition: + | ro(identification_division) + op = object_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + ddo = ro(loc(data_division)) + pdo = ro(object_procedure_division) + END OBJECT "." + { { instance_implements = op; + instance_options = opo; + instance_env = edo; + instance_data = ddo; + instance_methods = pdo } } + +interface_definition [@cost 999]: + | ro(identification_division) + iid = interface_id_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + pdo = ro(object_procedure_division) + END INTERFACE ei = name "." + { let interface_name, interface_as, + interface_inherits, interface_usings = iid in + { interface_name; + interface_as; + interface_inherits; + interface_usings; + interface_options = opo; + interface_env = edo; + interface_methods = pdo; + interface_end_name = ei } } + +method_definition: (* Note: used in PROCEDURE DIVISION, see below *) + | ro(identification_division) + mid = method_id_paragraph + opo = ro(options_paragraph) + edo = ro(loc(environment_division)) + ddo = ro(loc(data_division)) + pdo = ro(procedure_division) + END METHOD em = name "." + { let method_name, method_kind, method_override, method_final = mid in + { method_name; + method_kind; + method_override; + method_final; + method_options = opo; + method_env = edo; + method_data = ddo; + method_proc = pdo; + method_end_name = em } } + + + +let identification_division := + | IDENTIFICATION; DIVISION; "." + +let informational_paragraphs := (* ~COB85, -COB2002 *) + | ao = loc(AUTHOR)?; + io = loc(INSTALLATION)?; + dwo = loc(DATE_WRITTEN)?; + dco = loc(DATE_COMPILED)?; + so = loc(SECURITY)?; + { { author = ao; + installation = io; + date_written = dwo; + date_compiled = dco; + security = so } } + +let as__strlit_ := ~ = ro (pf (AS, string_literal)); < > + +let program_id_paragraph [@context program_id_paragraph] := + | PROGRAM_ID; "."; i = name; slo = as__strlit_; + pko = o(IS?; pk = program_kind; PROGRAM?; { pk }); "."; + { i, slo, pko } + +let program_kind := + | COMMON; {Common} (* Only within a nested program *) + | INITIAL; {Initial} + | RECURSIVE; {Recursive} + +let program_prototype_id_paragraph := (* +COB2002 *) + | PROGRAM_ID; "."; i = name; slo = as__strlit_; IS?; PROTOTYPE; "."; + { i, slo } + +let function_id_paragraph := + | FUNCTION_ID; "."; i = name; slo = as__strlit_; + proto = ibo(IS?; PROTOTYPE; {}); "."; (* +COB2002 *) + { i, slo, proto } + +let class_id_paragraph := (* +COB2002 *) + | CLASS_ID; "."; i = name; slo = as__strlit_; f = bo(IS?; FINAL; {}); + il1 = lo(INHERITS; FROM?; il = names; { il }); + il2 = lo(USING; il = names; { il }); "."; + { i, slo, f, il1, il2 } + +let factory_paragraph [@context factory_paragraph] := (* +COB2002 *) + | FACTORY; "."; ~ = lo(IMPLEMENTS; ~ = names; "."; < >); < > + +let object_paragraph [@context object_paragraph] := (* +COB2002 *) + | OBJECT; "."; ~ = lo(IMPLEMENTS; ~ = names; "."; < >); < > + +let interface_id_paragraph := (* +COB2002 *) + | INTERFACE_ID; "."; i = name; slo = as__strlit_; + il1 = lo(INHERITS; FROM?; il = names; { il }); + il2 = lo(USING; il = names; { il }); "."; + { i, slo, il1, il2 } + +let method_id_paragraph := (* +COB2002 *) + | METHOD_ID; "."; i = name; slo = as__strlit_; + o = bo(OVERRIDE); f = bo(IS?; FINAL; {}); + { i, NamedMethod { as_ = slo }, o, f } + | METHOD_ID; "."; pk = property_kind; PROPERTY; i = name; + o = bo(OVERRIDE); f = bo(IS?; FINAL; {}); + { i, PropertyMethod { kind = pk }, o, f } + +let options_paragraph [@context options_paragraph] := (* +COB2002 *) + | OPTIONS; "."; ~ = lo(sf(rnel(loc(options_clause)),".")); < > + +let options_clause := + | ~ = arithmetic_clause; < > + | ~ = rounded_clause; < > + | ~ = entry_convention_clause; < > + | ~ = float_binary_clause; < > + | ~ = float_decimal_clause; < > + | ~ = intermediate_rounding_clause; < > + +let arithmetic_clause [@context arithmetic_clause] := + | ARITHMETIC; IS?; ~ = arithmetic_mode; + +let arithmetic_mode := + | NATIVE; {Native} + | STANDARD; {Standard} (* ~COB2002 *) + | STANDARD_BINARY; {StandardBinary} + | STANDARD_DECIMAL; {StandardDecimal} + +let rounded_clause [@context rounded_phrase] := + | DEFAULT; ROUNDED; MODE?; IS?; ~ = rounding_mode; + +let entry_convention_clause [@context entry_convention_clause] := + | ENTRY_CONVENTION; IS?; COBOL; {EntryConvention COBOL} +(*| ENTRY_CONVENTION IS i = implementor_name (* none defined in standard *) + { EntryConvention i } *) + +let float_binary_clause [@context float_binary_clause] := + | FLOAT_BINARY; DEFAULT?; IS?; ~ = endianness_mode; + +let float_decimal_clause [@context float_decimal_clause] := + | FLOAT_DECIMAL; DEFAULT?; IS?; ~ = encoding_endianness; + +let intermediate_rounding_clause [@context intermediate_rounding_clause] := + | INTERMEDIATE; ROUNDING; IS?; ~ = rounding_mode; + (* CHECKME: not all are valid *) + + +(* ------------------------- ENVIRONMENT DIVISION -------------------------- *) + +let environment_division := + | ENVIRONMENT; DIVISION; "."; + c = ro(configuration_section); + io = ro(input_output_section); + { { env_configuration = c; + env_input_output = io; } } + + + +(* ------------- ENVIRONMENT DIVISION / CONFIGURATION SECTION -------------- *) + +configuration_section: + | CONFIGURATION SECTION "." + sco = ro(source_computer_paragraph) + oco = ro(object_computer_paragraph) + sno = ro(special_names_paragraph) + ro = ro(repository_paragraph) (* +COB2002 *) + { { source_computer_paragraph = sco; + object_computer_paragraph = oco; + special_names_paragraph = sno; + repository_paragraph = ro; } } + + + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / SOURCE-COMPUTER PARAGRAPH *) + +let source_computer_paragraph := (* WITH DEBUGGING MODE removed in COB2002 *) + | SOURCE_COMPUTER; "."; "."?; (* COB2002 allows two consecutive dots *) + {None} + | SOURCE_COMPUTER; "."; i = name; wdm = bo(WITH?; DEBUGGING; MODE; {}); "."; + {Some { source_computer_name = i; + source_computer_with_debugging_mode = wdm; } } + + + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / OBJECT-COMPUTER PARAGRAPH *) + +let object_computer_paragraph [@context object_computer_paragraph] := + | OBJECT_COMPUTER; "."; "."?; (* COB2002 allows two consecutive dots *) + {None} + | OBJECT_COMPUTER; "."; i = name; ocl = rl(loc(object_computer_clause)); "."; + {Some { object_computer_name = i; object_computer_clauses = ocl; }} + +let object_computer_clause := + | ~ = memory_size_clause; < > (* ~COB85, -COB2002 *) + | ~ = character_classification_clause; < > (* +COB2002 *) + | ~ = program_collating_sequence_clause; < > (* COB85 != COB2002 *) + | ~ = segment_limit_clause; < > (* -COB2002 *) + +let memory_size_clause := (* ~COB85, -COB2002 *) + | MEMORY; SIZE?; ~ = integer; ~ = memory_size_unit; + +let memory_size_unit := + | WORDS; {MemoryWords} + | CHARACTERS; {MemoryCharacters} + | MODULES; {MemoryModules} + +let character_classification_clause := (* +COB2002 *) + | CHARACTER?; CLASSIFICATION; cc = character_classification; + { let a, n = cc in + ComputerCharClassification { alphanumeric = a; national = n } } + +let character_classification := + | IS?; l = locale_phrase; lo = ro(locale_phrase); { Some l, lo } + | l = cc_alphanumeric; { Some l, None } + | l = cc_national; { None, Some l } + | la = cc_alphanumeric; ln = cc_national; { Some la, Some ln } + | ln = cc_national; la = cc_alphanumeric; { Some la, Some ln } + +let cc_alphanumeric := FOR; ALPHANUMERIC; IS?; ~ = locale_phrase; < > +let cc_national := FOR; NATIONAL; IS?; ~ = locale_phrase; < > + +let locale_phrase := + | i = name; { CharClassificationName i } + | LOCALE; { CharClassificationLocale } + | SYSTEM_DEFAULT; { CharClassificationSystemDefault } + | USER_DEFAULT; { CharClassificationUserDefault } + +let program_collating_sequence_clause := (* COB85 != COB2002 *) + | PROGRAM?; COLLATING?; SEQUENCE; ~ = alphabet_specification; + + +let segment_limit_clause := (* -COB2002 *) + | SEGMENT_LIMIT; IS?; ~ = integer; + + + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / SPECIAL-NAMES PARAGRAPH *) + +let special_names_paragraph := + | SPECIAL_NAMES; "."; ~ = rnel(loc(special_names_clause)); "."; < > + | SPECIAL_NAMES; "."; "."?; { [] } (* COB2002 allows two consecutive dots *) + +let special_names_clause [@post.special_names] := + (* Note: most can be used multiple times *) + | ~ = alphabet_name_clause; < > + | ~ = class_name_clause; < > + | ~ = crt_status_clause; < > (* +COB2002 *) + | ~ = currency_sign_clause; < > + | ~ = cursor_clause; < > (* +COB2002 *) + | ~ = decimal_point_clause; < > + | ~ = dynamic_length_structure_clause; < > (* +COB2002 *) + | ~ = locale_clause; < > (* +COB2002 *) + | ~ = mnemonic_name_clause; < > + | ~ = symbolic_characters_clause; < > + | ~ = order_table_clause; < > (* +COB2002 *) + +let alphabet_name_clause [@context alphabet_clause] := + | ALPHABET; i = name; an = for_alphanumeric_or_national_opt; + IS; cs = character_set; + { AlphabetName { alphabet_name = i; category = an; characters = cs } } + +let character_set := + | LOCALE; %prec lowest { CharSetLocale None } (* +COB2002 *) + | LOCALE; i = name; { CharSetLocale (Some i) } (* +COB2002 *) + | NATIVE; { CharSetNative } + | STANDARD_1; { CharSetStandard_1 } (* Alphanum only *) + | STANDARD_2; { CharSetStandard_2 } (* Alphanum only *) + | UCS_4; { CharSetUCS_4 } (* +COB2002 *) (* National only *) + | UTF_8; { CharSetUTF_8 } (* +COB2002 *) (* National only *) + | UTF_16; { CharSetUTF_16 } (* +COB2002 *) (* National only *) + | ll = rnel(literal_phrase); { CharSetCharacters ll } +(*| i = implementor_name { } *) (* the standard does not define any *) + +let literal_phrase := + | l = string_or_int_literal; + {CharactersRange (SingleCharacter l)} + | l1 = string_or_int_literal; THROUGH; l2 = string_or_int_literal; + {CharactersRange (CharacterRange { start_item = l1; end_item = l2 })} + | l = string_or_int_literal; ll = rnel(pf(ALSO,string_or_int_literal)); + {CharactersList (l :: ll)} + +let class_name_clause := + | CLASS; i = name; + an = for_alphanumeric_or_national_opt; IS?; (* +COB2002 *) + ll = nel(l = string_or_int_literal; lo = ro(pf(THROUGH,string_or_int_literal)); + { match lo with + | None -> SingleCharacter l + | Some l' -> CharacterRange { start_item = l; end_item = l' }}); + io = ro(pf(IN,name)); + { ClassName { class_name = i; category = an; characters = ll; source_charset = io } } + +let crt_status_clause := (* +COB2002 *) + | CRT; STATUS; IS?; ~ = name; + +let currency_sign_clause [@context currency_clause] := + | CURRENCY; SIGN?; IS?; l = string_literal; (* not fig const (hex allowed) *) + lo = ro(pf(WITH?; PICTURE; IS?; p = loc(PICTURE_STRING); SYMBOL; + { p }, string_literal)); (* +COB2002 *) + { CurrencySign { sign = l; picture_symbol = lo } } (* not fig const, not hex, 1 + char *) + +let cursor_clause := (* +COB2002 *) + | CURSOR; IS?; ~ = name; + +let decimal_point_clause := + | DECIMAL_POINT; IS?; COMMA; {DecimalPointIsComma} + +let dynamic_length_structure_clause + [@context dynlen_struct_clause] := (* +COB2002 *) + | DYNAMIC; LENGTH; STRUCTURE?; i = name; IS?; sk = structure_kind; + { DynLenStruct { name = i; kind = sk; } } + +let structure_kind := + | sn = bo(SIGNED); sh = bo(SHORT); PREFIXED; + { DynLenPrefixed { signed = sn; short = sh } } + | DELIMITED; {DynLenDelimited} + | ~ = name; + +let locale_clause := (* +COB2002 *) + | LOCALE; i = name; IS?; is = name_or_string; + { SpecialNameLocale { locale_name = i; external_name = is } } + +(* This requires the implementor to actually define custom system names + for switches, devices and features - the standard does not define any *) +let mnemonic_name_clause := + | i = name; mns = mnemonic_name_suffix; + { let (mno, sso) = mns in + MnemonicName { implementor_name = i; mnemonic_name = mno; status = sso } } + +let mnemonic_name_suffix := + | IS; n = name; { Some n, None } + | ss = status_switch; { None, Some ss } + | IS; n = name; ss = status_switch; { Some n, Some ss } + +let status_switch := + | ON; STATUS?; IS?; i = name; { StatusSwitchOn i } + | OFF; STATUS?; IS?; i = name; { StatusSwitchOff i } + | (i1, i2) = mr( ON; STATUS?; IS?; i1 = name; + OFF; STATUS?; IS?; i2 = name; {i1, i2} + | OFF; STATUS?; IS?; i2 = name; + ON; STATUS?; IS?; i1 = name; {i1, i2}); + { StatusSwitch {on_ = i1; off = i2} } + +let symbolic_characters_clause := + | SYMBOLIC; CHARACTERS?; + an = for_alphanumeric_or_national_opt; (* +COB2002 *) + scl = nel(~ = names; or_(IS,ARE)?; ~ = integers; < >); + io = ro(pf(IN,name)); + { SymbolicChars { category = an; characters = scl; source_charset = io } } + +let order_table_clause := (* +COB2002 *) + | ORDER; TABLE; i = name; IS?; l = string_literal; + { OrderTable { ordering_name = i; cultural_ordering = l } } + +let for_alphanumeric_or_national_opt := + | (* epsilon *) {Alphanumeric} + | FOR?; ALPHANUMERIC; {Alphanumeric} + | FOR?; NATIONAL; {National} + + + +(* ENVIRONMENT DIVISION / CONFIGURATION SECTION / REPOSITORY PARAGRAPH *) + +let repository_paragraph := (* +COB2002 *) + | REPOSITORY; "."; ~ = ilo(sf(rnel(specifier),".")); < > + +let specifier := + | ~ = class_specifier; < > + | ~ = interface_specifier; < > + | ~ = function_specifier; < > + | PROGRAM; i = name; lo = as__strlit_; + { ProgramSpecifier { name = i; external_name = lo } } + | PROPERTY; i = name; lo = as__strlit_; + { PropertySpecifier { name = i; external_name = lo } } + +let class_specifier [@context class_specifier] := + | CLASS; i = name; lo = as__strlit_; eo = ro(expands_phrase); + { ClassSpecifier { name = i; external_name = lo; expands = eo } } + +let interface_specifier [@context interface_specifier] := + | INTERFACE; i = name; lo = as__strlit_; eo = ro(expands_phrase); + { InterfaceSpecifier { name = i; external_name = lo; expands = eo } } + +let expands_phrase := + | EXPANDS; i = name; USING; il = names; + { { expands_name = i; expands_using = il } } + +let function_specifier [@context function_specifier] := + | FUNCTION; i = name; lo = as__strlit_; + { UserFunctionSpecifier { name = i; external_name = lo } } + | FUNCTION; ~ = names; INTRINSIC; + | FUNCTION; ALL; INTRINSIC; {IntrinsicFunctionAllSpecifier} + +(* -------------- ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION -------------- *) + +let input_output_section := + | INPUT_OUTPUT; SECTION; "."; + fco = ro(file_control_paragraph); (* COB85: mandatory *) + ioco = ro(io_control_paragraph); + { { file_control_paragraph = fco; + io_control_paragraph = ioco; } } + + + +(* - ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION / FILE-CONTROL PARAGRAPH -- *) + +let file_control_paragraph := + | FILE_CONTROL; "."; ~ = rl(select); < > (* COB85: non-empty list *) + +let select := + | SELECT; o = bo(OPTIONAL); i = name; + fcl = rnel(loc(select_clause)); "."; + { { select_optional = o; + select_name = i; + select_clauses = fcl } } + +let select_clause := (* Note: some can be used multiple times *) + | ~ = assign_clause; < > + | ~ = access_mode_clause; < > + | ~ = alternate_record_key_clause; < > + | ~ = collating_sequence_clause; < > (* +COB2002 *) + | ~ = file_status_clause; < > + | ~ = lock_mode_clause; < > (* +COB2002 *) + | ~ = organization_clause; < > + | ~ = padding_character_clause; < > (* -COB2002 *) + | ~ = record_delimiter_clause; < > + | ~ = record_key_clause; < > + | ~ = relative_key_clause; < > + | ~ = reserve_clause; < > + | ~ = sharing_clause; < > (* +COB2002 *) + +let assign_clause := (* USING added in COB2002 *) + | ASSIGN; TO?; _assign_external_?; + il = rnel(name_or_alphanum); io = ro(pf(USING,name)); + { SelectAssign { to_ = il; using = io } } + | ASSIGN; USING; i = name; + { SelectAssign { to_ = []; using = Some i; } } + +let _assign_external_ [@post.pending fun () -> "EXTERNAL"] := + | EXTERNAL + +let access_mode_clause := + | ACCESS; MODE?; IS?; ~ = access_mode; + +let access_mode := + | DYNAMIC; {AccessModeDynamic} + | RANDOM; {AccessModeRandom} + | SEQUENTIAL; {AccessModeSequential} + +let alternate_record_key_clause := + | ALTERNATE; RECORD; KEY?; IS?; i = qualname; + il = lo(pf(SOURCE; IS?; {}, names)); + wd = bo(WITH?; DUPLICATES; {}); + { SelectAlternateRecordKey { key = i; source = il; + with_duplicates = wd } } + +let collating_sequence_clause := (* +COB2002 *) + | COLLATING?; SEQUENCE; ~ = alphabet_specification; + + | COLLATING?; SEQUENCE; OF; il = names; IS; i = name; + {SelectCollatingSequenceOfKey { keys = il; alphabet = i } } + | COLLATING?; SEQUENCE; OF; il = ntl(name); + {let i, il = split_last il in + SelectCollatingSequenceOfKey { keys = il; alphabet = i } } + +let file_status_clause := + | FILE?; STATUS; IS?; ~ = qualname; + +let lock_mode_clause [@context lock_mode_clause] := (* +COB2002 *) + | LOCK; MODE?; IS?; lm = lock_mode; wl = with_lock_clause; + { SelectLockMode { mode = lm; with_lock = wl } } + +let with_lock_clause [@recovery WithLockNone] := + | { WithLockNone } + | WITH; LOCK; ON; m = bo(MULTIPLE); or_(RECORD,RECORDS); + { WithLock { multiple = m } } + +let lock_mode := + | MANUAL; {LockManual} + | AUTOMATIC; {LockAutomatic} + +let organization_clause := + | io(ORGANIZATION; IS?; {}); ~ = organization; + +let organization := + | INDEXED; {OrganizationIndexed} + | RELATIVE; {OrganizationRelative} + | LINE?; SEQUENTIAL; {OrganizationSequential} (* LINE for microfocus *) + +let padding_character_clause := (* -COB2002 *) + | PADDING; CHARACTER?; IS?; ~ = qualname_or_alphanum; + + +let record_delimiter_clause := + | RECORD; DELIMITER; IS?; ~ = record_delimiter; + +let record_delimiter := + | STANDARD_1; {Standard_1} +(*| m = mnemonic_name {}*) (* none defined by the standard *) + +let record_key_clause := + | RECORD; KEY?; IS?; i = qualname; + il = lo(pf(SOURCE; IS?,names)); + { SelectRecordKey { key = i; source = il } } + +let relative_key_clause := + | RELATIVE; KEY?; IS?; ~ = name; + +let reserve_clause := + | RESERVE; ~ = integer; or_(AREA,AREAS)?; + +let sharing_clause [@context sharing_clause] := (* +COB2002 *) (* Note: identical to sharing_phrase *) + | SHARING; WITH?; ~ = sharing_mode; + + + +(* -- ENVIRONMENT DIVISION / INPUT-OUTPUT SECTION / I-O-CONTROL PARAGRAPH -- *) + +let io_control_paragraph := + | I_O_CONTROL; "."; ~ = io_control_entry?; < > + +let io_control_entry := + | rcl = rl(loc(rerun_clause)); (* -COB2002 *) + sal = rl(loc(same_area_clause)); + mfl = rl(loc(multiple_file_clause)); (* -COB2002 *) + "."; + { { io_control_rerun_clauses = rcl; + io_control_same_area_clauses = sal; + io_control_multiple_file_clauses = mfl; } } + +let rerun_clause := (* -COB2002 *) + | RERUN; io = ro(pf(ON,name)); EVERY?; rf = rerun_frequency; + { { rerun_on = io; rerun_every = rf } } + +let rerun_frequency := + | END; OF?; or_(REEL,UNIT); OF?; ~ = name; + | i = integer; RECORDS; OF?; id = name; {RerunRecords (i, id)} + | ~ = integer; CLOCK_UNITS; + | ~ = name; + +let same_area_clause := + | SAME; as_ = area_source; AREA?; FOR?; i = name; il = names; + { { same_area_source = as_; + same_area_file_name = i; + same_area_file_names = il } } + +let area_source := + | {AreaSourceFile} + | RECORD; {AreaSourceRecord} + | SORT; {AreaSourceSortMerge} + | SORT_MERGE; {AreaSourceSortMerge} + +let multiple_file_clause := (* -COB2002 *) + | MULTIPLE; FILE; TAPE?; CONTAINS?; + ~ = nel(i = name; io = ro(pf(POSITION,integer)); + { { file_portion_name = i; file_portion_position = io } }); < > + + + + + +(* ----------------------------- DATA DIVISION ----------------------------- *) + +(* +- file section + - file description : constant, record, type + - sort-merge description : constant, record, type +- working storage section : constant, 77-level, record, type +- local storage section : constant, 77-level, record, type +- linkage section : constant, 77-level, record, type +- report section + - report description : constant, report group +- screen section : constant, screen + ++ file description : FD file-name file-clauses* . ++ sort-merge desc : SD file-name record-clause? . ++ report description : RD report-name report-clauses* . + +- constant +- 77-level data description +- record description (data description with NO TYPEDEF in level 1) +- type declaration (data description with a TYPEDEF) += data description (level-number entry-name? data-clause* ) + +- report group description (level-number entry-name? report-group-clauses* ) + +- screen description (level-number screen-name? screen-clauses* ) + +* 01 constant-name CONSTANT [IS GLOBAL] AS/FROM ... (constant) +* nn entry_name? type/next-group/line/picture/USAGE/... (report) +* nn entry_name? REDEFINES/TYPEDEF/ALIGNED/BASED/picture... (data=record/type) +* nn entry_name? GLOBAL/LINE/COLUMN/FULL/USAGE... (screen) + +(* +record description entry = + set of data description entries, first one of level 1 +-> data item with level 1 without TYPEDEF is a record + may be described as level-77 entries + +type declaration entry = + data description entry that contains a TYPEDEF clause + lay have hierarchical structure + +8.5.1.2, Levels, and in 13.16, Data description entry. +13.18.58, TYPEDEF clause. + +*) + +*) + +data_division: + | DATA DIVISION "." + fso = ro(file_section) + wsso = ro(working_storage_section) + lsso = ro(local_storage_section) (* +COB2002 *) + lso = ro(linkage_section) + cso = ro(communication_section) (* -COB2002 *) + rso = ro(report_section) + sso = ro(screen_section) (* +COB2002 *) + { { file_section = fso; + working_storage_section = wsso; + local_storage_section = lsso; + linkage_section = lso; + communication_section = cso; + report_section = rso; + screen_section = sso; } } + + +let section(K, L) == + | K; SECTION; "."; ~ = rl(loc(L)); < > + +let file_section := + | ~ = section (FILE, file_or_sort_merge_descr_entry); < > + +let working_storage_section := + | ~ = section (WORKING_STORAGE, constant_or_data_descr_entry); < > + +let local_storage_section := (* +COB2002 *) + | ~ = section (LOCAL_STORAGE, constant_or_data_descr_entry); < > + +let linkage_section := (* +COB2002 *) + | ~ = section (LINKAGE, constant_or_data_descr_entry); < > + +let communication_section := (* -COB2002 *) + | ~ = section (COMMUNICATION, communication_descr_entry); < > + +let report_section := + | ~ = section (REPORT, report_descr_entry); < > + +let screen_section := (* +COB2002 *) + | ~ = section (SCREEN, constant_or_screen_descr_entry); < > + + +let elementary_level == ~ = DIGITS; + +let constant_level := + | EIGHTY_EIGHT; { with_loc 88 $sloc } + + +file_or_sort_merge_descr_entry: + | FD i = name + fcl = rl(loc(file_descr_clause)) "." + cdl = rl(loc(constant_or_data_descr_entry)) + { { file_name = i; + file_items = cdl; + file_clauses = FileFD fcl } } + | SD i = name + scl = rl(loc(sort_merge_file_descr_clause)) "." + cdl = rl(loc(constant_or_data_descr_entry)) + { { file_name = i; + file_items = cdl; + file_clauses = FileSD scl } } + +communication_descr_entry: + | CD i = name FOR? in_ = bo(INITIAL) INPUT + cl = rl(loc(communication_descr_clause)) + il = rl(loc(entry_name_clause)) "." + cdl = rl(loc(constant_or_data_descr_entry)) + { { comm_name = i; + comm_clauses = cl; + comm_items = cdl; + comm_direction = CommInput { initial = in_; items = il } } } + | CD i = name FOR? in_ = bo(INITIAL) I_O + cl = rl(loc(communication_descr_clause)) il = rl(name) "." + cdl = rl(loc(constant_or_data_descr_entry)) + { { comm_name = i; + comm_clauses = cl; + comm_items = cdl; + comm_direction = CommIO { initial = in_; items = il } } } + | CD i = name FOR? OUTPUT + cl = rl(loc(communication_descr_clause)) "." + cdl = rl(loc(constant_or_data_descr_entry)) + { { comm_name = i; + comm_clauses = cl; + comm_items = cdl; + comm_direction = CommOutput } } + +let report_descr_entry := + | RD; i = name; rl = rl(loc(report_descr_clause)); "."; + crl = rl(loc(constant_or_report_group_descr_entry)); + { { report_name = i; + report_clauses = rl; + report_items = crl } } + +let constant_or_data_descr_entry := + | e = constant; + { Constant e } + | e = data_descr_entry; + { Data e } (* including level 77 entries *) + | l = loc(elementary_level); dn = name; RENAMES; ri = qualname; + to_ = o(THROUGH; ~ = qualname; < >); "."; + { Renames { rename_level = l; + rename_to = dn; + rename_renamed = ri; + rename_through = to_ } } + | l = constant_level; cn = name; + er(VALUE; IS? | VALUES; ARE?); vl = rnel(literal_through_literal); + ao = o(IN; ~ = name; < >); + wfo = o(WHEN?; SET?; TO?; FALSE; IS?; ~ = literal; < >); "."; + { CondName { condition_name_level = l; + condition_name = cn; + condition_name_values = vl; + condition_name_alphabet = ao; + condition_name_when_false = wfo; } } +(* integer ident? cond_value_clause (level 88 entries) *) + +literal_through_literal: + | l1 = literal + { { condition_name_value = l1; condition_name_through = None } } + | l1 = literal THROUGH l2 = literal + { { condition_name_value = l1; condition_name_through = Some l2 } } + +constant_or_report_group_descr_entry: + | e = constant + { Constant e: report_item_descr } + | e = report_group_descr_entry + { ReportGroup e } + +let constant_or_screen_descr_entry := + | ~ = constant; + | s = screen_descr_entry; {Screen s} + +let file_descr_clause := + | ~ = external_clause; + | global_clause; {FileGlobal} + | ~ = format_clause; < > (* +COB2002 *) + | ~ = block_contains_clause; < > + | ~ = record_clause; + | ~ = label_clause; (* -COB2002 *) + | ~ = value_of_clause; (* -COB2002 *) + | ~ = data_clause; (* -COB2002 *) + | ~ = linage_clause; + | ~ = code_set_clause; + | ~ = report_clause; + +let sort_merge_file_descr_clause := + | ~ = record_clause; + | ~ = data_clause; (* -COB2002 *) + | global_clause; {FileSDGlobal} + +communication_descr_clause: + | SYMBOLIC? QUEUE IS? i = name { CommSymbolic (CommQueue, i) } (* IN *) + | SYMBOLIC? SUB_QUEUE_1 IS? i = name { CommSymbolic (CommSubQueue1, i) } (* IN *) + | SYMBOLIC? SUB_QUEUE_2 IS? i = name { CommSymbolic (CommSubQueue2, i) } (* IN *) + | SYMBOLIC? SUB_QUEUE_3 IS? i = name { CommSymbolic (CommSubQueue3, i) } (* IN *) + | SYMBOLIC? SOURCE IS? i = name { CommSymbolic (CommSource, i) } (* IN *) + | SYMBOLIC? TERMINAL IS? i = name { CommSymbolic (CommTerminal, i) } (* I-O *) + | io(SYMBOLIC) DESTINATION IS? i = name { CommSymbolic (CommDestination, i) } (* OUT *) + | DESTINATION COUNT IS? i = name { CommDestinationCount i } (* OUT *) + | DESTINATION TABLE OCCURS + i = integer TIMES? + il = lo(pf(INDEXED BY? {},nel(name))) { CommDestinationTable (i, il) } (* OUT *) + | MESSAGE? COUNT IS? i = name { CommMessageCount i } (* IN *) + | MESSAGE DATE IS? i = name { CommMessageDate i } (* IN/I-O *) + | MESSAGE TIME IS? i = name { CommMessageTime i } (* IN/I-O *) + | TEXT LENGTH IS? i = name { CommTextLength i } (* IN/OUT/I-O *) + | STATUS KEY IS? i = name { CommStatusKey i } (* IN/OUT/I-O *) + | END KEY IS? i = name { CommEndKey i } (* IN/I-O *) + | ERROR KEY IS? i = name { CommErrorKey i } (* OUT *) + +let report_descr_clause := + | global_clause; {Global} + | ~ = code_clause; < > + | ~ = control_clause; < > + | ~ = page_limit_clause; < > + + + +let format_clause := (* +COB2002 *) + | FORMAT; BIT; DATA?; {FileFormat Bit} + | FORMAT; CHARACTER; DATA?; {FileFormat Character} + | FORMAT; NUMERIC; DATA?; {FileFormat Numeric} + +let block_contains_clause := + | BLOCK; CONTAINS?; i = integer; io = io(pf(TO,integer)); + cr = file_block_contents; + { FileBlockContains { from = i; to_ = io; + characters_or_records = cr; } } + +let file_block_contents == + | {FileBlockContainsCharacters} + | CHARACTERS; {FileBlockContainsCharacters} + | RECORDS; {FileBlockContainsRecords} + +record_clause: + | RECORD CONTAINS? i = integer CHARACTERS? + { FixedLength i } + | RECORD CONTAINS? i1 = integer TO i2 = integer CHARACTERS? + { FixedOrVariableLength { min_length = i1; + max_length = i2 } } + | RECORD IS? VARYING IN? SIZE? + lengths = from_to_characters_opt + depending = ro(depending_phrase) + { let min_length, max_length = lengths in + VariableLength { min_length; max_length; depending } } + +from_to_characters_opt: + | CHARACTERS? { None, None } + | FROM? i1 = integer CHARACTERS? { Some i1, None } + | TO i2 = integer CHARACTERS? { None, Some i2 } + | FROM? i1 = integer TO i2 = integer CHARACTERS? { Some i1, Some i2 } + +label_clause: + | LABEL mr(RECORD IS? | RECORDS ARE? {}) STANDARD { LabelStandard } + | LABEL mr(RECORD IS? | RECORDS ARE? {}) OMITTED { LabelOmitted } + +value_of_clause: + | VALUE OF iil = nel(i = name IS? il = qualname_or_literal + { { value_of_valued = i; value_of_value = il; } }) + { iil } + +data_clause: + | DATA_RECORD IS? il = names { il } + | DATA_RECORDS ARE? il = names { il } + +linage_clause: + | l = linage_header + wfa = ro(pf(WITH? FOOTING AT? {}, qualname_or_integer)) + lat = io(pf(LINES? AT? TOP {}, qualname_or_integer)) + lab = ro(pf(LINES? AT? BOTTOM {}, qualname_or_integer)) + { { file_linage_lines = l; + file_linage_with_footing_at = wfa; + file_linage_lines_at_top = lat; + file_linage_lines_at_bottom = lab; } } + +let linage_header := + | LINAGE; IS?; ~ = qualname_or_integer; %prec below_LINES < > + | LINAGE; IS?; ~ = qualname_or_integer; LINES; < > + +let code_set_clause := + | CODE_SET; ~ = alphabet_specification; < > + +let report_clause_prefix == REPORT; IS? | REPORTS; ARE? +let report_clause := + | report_clause_prefix; ~ = names; < > + +let code_clause := CODE; IS?; ~ = ident; + +let control_clause_prefix == CONTROL; IS? | CONTROLS; ARE? +let control_clause := + | control_clause_prefix; il = names; { Control {final = false; controls = il} } + | control_clause_prefix; FINAL; il = rl(name); { Control {final = true; controls = il} } + +let limit_is_ == LIMIT; IS? | LIMITS; ARE? +let page_limit_clause := + | PAGE; limit_is_?; + lco = page_line_col; + ho = ro(pf(HEADING; IS?,integer)); + fdo = ro(pf(FIRST; DETAIL; IS?,integer)); + lcho = io(pf(LAST; mr(CH | CONTROL; HEADING); IS?,integer)); + ldo = ro(pf(LAST; DETAIL; IS?,integer)); + fo = ro(pf(FOOTING; IS?,integer)); + { let lo, co = lco in + PageLimit { lines = lo; + columns = co; + heading = ho; + first_detail = fdo; + last_control_heading = lcho; + last_detail = ldo; + footing = fo; } } + +let page_line_col := + | c = integer; COLUMNS; { None, Some c } + | l = integer; or_(LINE,LINES)?; { Some l, None } + | l = integer; or_(LINE,LINES); c = integer; COLUMNS; { Some l, Some c } + + + + +let constant (* [@context constant] *) := + (* BYTE-LENGTH is sensitive throughout "constant entry" w.r.t ISO/IEC 2014. + However, like in GnuCOBOL we restrict the scope to the only places where + the keyword is relevant. *) + | l = loc(elementary_level); + eno = ro(loc(entry_name_clause)); CONSTANT; + go = ibo(global_clause); + cv = loc(constant_value); "."; + { { constant_level = l; + constant_name = eno; + constant_global = go; + constant_value = cv } } + +let constant_value := + | AS; ~ = expression; (* or plain ident *) + | p = constant_value_length; OF?; n = name; + { match p with + | `ByteLength -> ConstByteLength n + | `Length -> ConstLength n } + | FROM; ~ = name; + +let constant_value_length [@context constant] := + | AS; BYTE_LENGTH; {`ByteLength} + | AS; LENGTH; {`Length} + +let data_descr_entry := + | l = loc(elementary_level); + eno = ro(loc(entry_name_clause)); + dcl = rl(loc(data_descr_clause)); "."; + { { data_level = l; + data_name = eno; + data_clauses = dcl } } + +let report_group_descr_entry := + | l = elementary_level; + eno = ro(loc(entry_name_clause)); + rcl = rl(loc(report_group_descr_clause)); "."; + { { report_level = l; + report_data_name = eno; + report_group_clauses = rcl } } + +let screen_descr_entry [@context screen_descr_entry] := + | l = elementary_level; + eno = ro(loc(entry_name_clause)); + scl = rl(loc(screen_descr_clause)); "."; + { { screen_level = l; + screen_data_name = eno; + screen_clauses = scl } } + +let entry_name_clause := + | ~ = name; (* data name / screen name *) + | FILLER; {DataFiller} + + + +data_descr_clause: (* P255 *) + | c = redefines_clause { DataRedefines c } + | c = typedef_clause { c } (* +COB2002 *) + | aligned_clause { DataAligned } (* +COB2002 *) + | any_length_clause { DataAnyLength } (* +COB2002 *) + | based_clause { DataBased } (* +COB2002 *) + | blank_when_zero_clause { DataBlankWhenZero } + | constant_record_clause { DataConstantRecord } (* +COB2002 *) + | c = dynamic_length_clause { c } (* +COB2002 *) + | c = external_clause { DataExternal c } + | global_clause { DataGlobal } + | c = group_usage_clause { DataGroupUsage c } (* +COB2002 *) + | justified_clause { DataJustified } + | c = data_occurs_clause { DataOccurs c } + | c = loc(picture_clause) { DataPicture c } + | c = loc(property_clause) { DataProperty c } (* +COB2002 *) + | c = same_as_clause { DataSameAs c } (* +COB2002 *) + | c = select_when_clause { DataSelectWhen c } (* +COB2002 *) + | c = sign_clause { DataSign c } + | c = synchronized_clause { DataSynchronized c } + | c = data_type_clause { DataType c } (* +COB2002 *) + | c = usage_clause { DataUsage c } + | c = validation_clause { DataValidation c } (* +COB2002 *) + | c = data_value_clause { DataValue c } + + +report_group_descr_clause: (* P286 *) + | c = report_type_clause { ReportType c } + | c = next_group_clause { ReportNextGroup c } + | c = report_line_clause { ReportLine c } + | c = loc(picture_clause) { ReportPicture c } + | c = report_screen_usage_clause { ReportUsage c } + | c = sign_clause { ReportSign c } + | justified_clause { ReportJustified } + | c = report_column_clause { c } + | blank_when_zero_clause { ReportBlankWhenZero } + | c = source_clause { c } + | c = sum_clause { c } + | c = report_value_clause { c } + | c = present_when_clause { ReportPresentWhen c } (* +COB2002 *) + | group_indicate_clause { ReportGroupIndicate } + | c = report_occurs_clause { c } (* +COB2002 *) + | c = varying_clause { ReportVarying c } (* +COB2002 *) + +screen_descr_clause: (* P293 *) (* +COB2002 *) + | global_clause { ScreenGlobal } + | c = screen_line_clause { ScreenLine c } + | c = screen_column_clause { ScreenColumn c } + | c = blank_clause { ScreenBlank c } + | c = erase_clause { ScreenErase c } + | c = screen_attribute_clauses { ScreenAttribute c } + | c = loc(picture_clause) { ScreenPicture c } + | c = source_destination_clauses { ScreenSourceDestination c } + | blank_when_zero_clause { ScreenBlankWhenZero } + | justified_clause { ScreenJustified } + | c = sign_clause { ScreenSign c } + | full_clause { ScreenFull } + | auto_clause { ScreenAuto } + | secure_clause { ScreenSecure } + | required_clause { ScreenRequired } + | c = screen_occurs_clause { ScreenOccurs c } + | c = report_screen_usage_clause { ScreenUsage c } + + + +(* ---------- Rules common to data, reports and screens ---------- *) + +let blank_when_zero_clause := BLANK; WHEN?; ZERO + +let justified_clause := JUSTIFIED; RIGHT? + +let picture_clause + [@recovery dummy_picture] + [@symbol ""] := + | PICTURE; IS?; picture = loc(PICTURE_STRING); + picture_locale = ro(picture_locale_phrase); + picture_depending = ro(depending_phrase); + { { picture; picture_locale; picture_depending } } + +let picture_locale_phrase + [@recovery { locale_name = None; locale_size = "0" }] + [@symbol ""] := + | LOCALE; io = pf(IS?, name)?; SIZE; IS?; i = integer; + { {locale_name = io; locale_size = i} } + +let sign_clause := + | o(SIGN; IS?; {}); + lt = mr(LEADING; { LeadingSign } | TRAILING; { TrailingSign }); + sc = bo(SEPARATE; CHARACTER?; {}); + { { sign_position = lt; + sign_separate_character = sc; } } + + + +(* ---------- Rules common to data, screens and constants ---------- *) + +let global_clause := GLOBAL | IS_GLOBAL + + + +(* ---------- Rules common to data and reports ---------- *) + +let key_is := + | ad = sort_direction; KEY?; IS?; il = qualnames; + { { sort_key_direction = ad; sort_key_names = il } } + +let sort_direction == + | ASCENDING; {SortAscending} + | DESCENDING; {SortDescending} + +let indexed_by := INDEXED; BY?; ~ = names; < > +let depending_phrase := DEPENDING; ON?; ~ = loc(reference); < > +let step_phrase := STEP; ~ = integer; < > + +let varying_clause := + | VARYING; ~ = nel(i = name; fe = ro(pf(FROM,expression)); + be = ro(pf(BY,expression)); + { { data_varying = i; + data_varying_from = fe; + data_varying_by = be; } }); < > + + + +(* ---------- Rules common to reports and screens ---------- *) + +let report_screen_usage_clause := + | USAGE; IS?; DISPLAY; { Display } + | USAGE; IS?; NATIONAL; { National } (* +COB2002 *) + + + +(* ---------- Rules specific to data ---------- *) + +let redefines_clause := REDEFINES; ~ = name; < > +let typedef_clause [@context typedef_clause] := + | or_(TYPEDEF,IS_TYPEDEF); s = bo(STRONG); { DataTypedef { strong = s } } +let aligned_clause := ALIGNED +let any_length_clause := ANY; LENGTH +let based_clause := BASED +let constant_record_clause := CONSTANT; RECORD + +let dynamic_length_clause := + | DYNAMIC; LENGTH?; ido = ro(name); io = ro(pf(LIMIT; IS?,integer)); + { DataDynamicLength { dynamic_length_structure_name = ido; limit_is = io } } + +let external_clause := + | or_(EXTERNAL,IS_EXTERNAL); ~ = as__strlit_; < > + +let group_usage_clause [@recover GroupUsageBit] := + | GROUP_USAGE; IS?; BIT; {GroupUsageBit} + | GROUP_USAGE; IS?; NATIONAL; {GroupUsageNational} + +let data_occurs_clause := + | ~ = occurs_fixed_clause; < > + | ~ = occurs_depending_clause; < > + | ~ = occurs_dynamic_clause; < > + +let occurs_fixed_clause [@context occurs_clause] := + | OCCURS; i = integer; TIMES?; kl = rl(key_is); ib = lo(indexed_by); + { OccursFixed { times = i; key_is = kl; indexed_by = ib; } } + +let occurs_depending_clause [@context occurs_clause] := + | OCCURS; i1 = integer; TO; i2 = integer; TIMES?; + d = depending_phrase; kl = rl(key_is); il = lo(indexed_by); + { OccursDepending { from = i1; to_ = i2; depending = d; + key_is = kl; indexed_by = il; } } + +let occurs_dynamic_clause [@context occurs_clause] := + | OCCURS; DYNAMIC; co = ro(capacity_phrase); + i1o = ro(pf(FROM,integer)); i2o = ro(pf(TO,integer)); + i = bo(INITIALIZED); kl = rl(key_is); il = lo(indexed_by); + { OccursDynamic { capacity_in = co; from = i1o; to_ = i2o; + initialized = i; key_is = kl; indexed_by = il; } } + +let capacity_phrase := CAPACITY; IN?; ~ = name; < > + +let property_clause := + | PROPERTY; + wno = ro(pf(WITH?; NO; {},property_kind)); + f = bo(IS?; FINAL; {}); + { { property_with_no = wno; property_is_final = f } } + +let property_kind == + | GET; {PropertyGet} + | SET; {PropertySet} +let same_as_clause := SAME; AS; ~ = name; < > +let select_when_clause := + | SELECT; WHEN; ~ = name; + | SELECT; WHEN; OTHER; {SelectWhenOther} + +let synchronized_clause := + | SYNCHRONIZED; LEFT; {SynchronizedLeft} + | SYNCHRONIZED; RIGHT; {SynchronizedRight} + | SYNCHRONIZED; {SynchronizedDefault} + +let data_type_clause := TYPE; TO?; ~ = name; < > + +let usage_clause := + | USAGE; IS?; ~ = usage; < > + | ~ = usage; < > (* COBOL85 *) + +usage [@context usage_clause (* ok as none of leftmost terminals are C/S *)]: + | BINARY { Binary } + | DISPLAY { Display } + | INDEX { Index } + | PACKED_DECIMAL { PackedDecimal } + (* All the following are +COB2002 *) + | BIT { Bit } + | BINARY_CHAR so = signedness_ { BinaryChar so } + | BINARY_SHORT so = signedness_ { BinaryShort so } + | BINARY_LONG so = signedness_ { BinaryLong so } + | BINARY_DOUBLE so = signedness_ { BinaryDouble so } + | FLOAT_EXTENDED { FloatExtended } + | FLOAT_LONG { FloatLong } + | FLOAT_SHORT { FloatShort } + | FLOAT_BINARY_32 eo = endianness_mode_ { FloatBinary32 eo } + | FLOAT_BINARY_64 eo = endianness_mode_ { FloatBinary64 eo } + | FLOAT_BINARY_128 eo = endianness_mode_ { FloatBinary128 eo } + | FLOAT_DECIMAL_16 ee = encoding_endianness_opt { FloatDecimal16 ee } + | FLOAT_DECIMAL_34 ee = encoding_endianness_opt { FloatDecimal34 ee } + | NATIONAL { National } + | OBJECT REFERENCE rk = ro(object_reference_kind) { ObjectReference rk } + | FUNCTION_POINTER TO? i = name { FunctionPointer i } + | POINTER io = ro(pf(TO?,name)) { Pointer io } + | PROGRAM_POINTER io = ro(pf(TO?,name)) { ProgramPointer io } + + | COMP { Binary } + | COMP_0 { UsagePending `Comp0 } + | COMP_1 { UsagePending `Comp1 } + | COMP_2 { FloatLong } + | COMP_3 { PackedDecimal } + | COMP_4 { Binary } + | COMP_5 { UsagePending `Comp5 } + | COMP_6 { UsagePending `Comp6 } + | COMP_X { UsagePending `CompX } + | COMP_N { UsagePending `CompN } + | COMP_9 { UsagePending `Comp9 } + | COMP_10 { UsagePending `Comp10 } + | COMP_15 { UsagePending `Comp15 } + +let signedness_ := ~ = ro(signedness); < > +let signedness == + | SIGNED; { Signed } + | UNSIGNED; { Unsigned } + +let endianness_mode_ := ~ = ro(endianness_mode); < > +let endianness_mode := + | HIGH_ORDER_LEFT; { HighOrderLeft } + | HIGH_ORDER_RIGHT; { HighOrderRight } + +let encoding_mode := + | BINARY_ENCODING; { BinaryEncoding } + | DECIMAL_ENCODING; { DecimalEncoding } + +let encoding_endianness_opt := + | { { encoding_mode = None; encoding_endianness = None } } + | ~ = encoding_endianness; < > + +let encoding_endianness := + | ecm = encoding_mode; + { {encoding_mode = Some ecm; encoding_endianness = None } } + | edm = endianness_mode; + { {encoding_mode = None; encoding_endianness = Some edm } } + | ecm = encoding_mode; edm = endianness_mode; + { {encoding_mode = Some ecm; encoding_endianness = Some edm } } + | edm = endianness_mode; ecm = encoding_mode; + { {encoding_mode = Some ecm; encoding_endianness = Some edm } } + +let object_reference_kind := + | f = bo(FACTORY; OF?; {}); ACTIVE_CLASS; + { ActiveClass { factory_of = f } } + | f = bo(FACTORY; OF?; {}); i = name; o = bo(ONLY); + { Name { class_or_interface_name = i; factory_of = f; only = o; } } + +let validation_clause := + | ~ = class_clause; + | ~ = default_clause; + | ~ = destination_clause; + | ~ = invalid_when_clause; + | ~ = present_when_clause; + | ~ = varying_clause; + | ~ = validate_status_clause; < > + +let class_clause := CLASS; IS?; ~ = class_; < > + +let class_ := + | ALPHABETIC; {Alphabetic} + | ALPHABETIC_LOWER; {AlphabeticLower} + | ALPHABETIC_UPPER; {AlphabeticUpper} + | BOOLEAN; {Boolean} + | NUMERIC; {Numeric} + | ~ = name; + +let default_clause [@context default_clause] := + | DEFAULT; IS?; ~ = ident_or_literal; + | DEFAULT; IS?; NONE; {None} + +let destination_clause := DESTINATION; IS?; ~ = idents; < > +let invalid_when_clause := ~ = nel(INVALID; WHEN; ~ = condition; < >); < > +let validate_status_clause [@context validate_status_clause] := + | VALIDATE_STATUS; + IS?; il = ident_or_literal; + WHEN?; ene = error_or_no_error; + vsl = lo(pf(ON,rnel(validation_stage))); + FOR; idl = idents; + { ValidateStatus { is_ = il; when_ = ene; on = vsl; for_ = idl; } } + +let error_or_no_error := + | ERROR; {ValidateWhenError} + | NO; ERROR; {ValidateWhenNoError} + +let validation_stage := + | FORMAT; {ValidationStageFormat} + | CONTENT; {ValidationStageContent} + | RELATION; {ValidationStageRelation} + +let data_value_clause_prefix == VALUE; IS? | VALUES; ARE? +let data_value_clause := + | data_value_clause_prefix; ~ = literal; + | data_value_clause_prefix; ~ = nel(ll = rnel(literal); FROM; fl = subscripts; + tl = lo(TO; ~ = subscripts; < >); + { { table_data_values = ll; + table_data_from = fl; + table_data_to = tl } }); + +(* /* *) +(* cond_value_clause: // for 88 entries *) +(* | mr(VALUE IS? | VALUES ARE? {}) *) +(* ll = literal_through_literal+ *) +(* ao = pf(IN,ident)? *) +(* wf = pf(WHEN? SET? TO? FALSE IS? {},literal)? *) +(* {} *) +(* | or_(VALUE,VALUES) *) +(* ll = literal_through_literal+ *) +(* ao = pf(IN,ident)? *) +(* vi = pf(or_(IS,ARE)?,valid_or_invalid) *) +(* wc = pf(WHEN,condition)? *) +(* {} *) +(* ; *) + +(* literal_through_literal: // literal range *) +(* | l = literal lo = pf(THROUGH,literal)? { (l, lo) } *) +(* ; *) + +(* valid_or_invalid: *) +(* | VALID { Valid } *) +(* | INVALID { Invalid } *) +(* ; *) +(* */ *) + + + +(* ---------- Rules specific to reports ---------- *) + +report_type_clause: + | TYPE IS? DETAIL { Detail } + | TYPE IS? mr(RH | REPORT HEADING {}) { ReportHeading } + | TYPE IS? mr(RF | REPORT FOOTING {}) { ReportFooting } + | TYPE IS? mr(PH | PAGE HEADING {}) { PageHeading } + | TYPE IS? mr(PF | PAGE FOOTING {}) { PageFooting } + | TYPE IS? mr(CH | CONTROL HEADING {}) + fo = o(io(or_(ON,FOR)) + if_ = report_data_name_or_final op = bo(OR PAGE {}) { if_, op }) + { ControlHeading fo } + | TYPE IS? mr(CF | CONTROL FOOTING {}) + fo = o(io(or_(ON,FOR)) + if_ = report_data_name_or_final { if_ } ) + { ControlFooting fo } + +next_group_clause: + | NEXT GROUP IS? i = integer { ReportNextAbsolute i } + | NEXT GROUP IS? or_(PLUS,"+") i = integer { ReportNextRelative i } + | NEXT GROUP IS? NEXT PAGE wr = bo(WITH? RESET {}) { ReportNextNextPage wr } + +report_line_clause: + | line_header pl = rnel(line_position) { pl } + +line_header [@context line_clause (*NUMBERS only*)]: + | LINE mr(NUMBER IS? | NUMBERS ARE? | or_(IS,ARE)? {}) | LINES ARE {} + +line_position: + | i = integer %prec lowest { LineAbsolute (i, false) } + | i = integer io(ON) NEXT_PAGE { LineAbsolute (i, true) } + | or_(PLUS,"+") i = integer { LineRelative i } + | ON? NEXT_PAGE { LineOnNextPage } + +report_column_clause: + | a = column_header or_(IS,ARE)? pl = rnel(column_position) + { ReportColumn { alignment = a; position = pl } } + +let column_header [@context column_clause (* NUMBERS & CENTER *)] := + | or_(COL,COLUMN); or_(NUMBER,NUMBERS)?; ~ = alignment; < > + | COLUMNS; ~ = alignment; < > + +let column_position := + | ~ = integer; + | or_(PLUS,"+"); ~ = integer; + +let alignment := + | LEFT?; {AlignLeft} + | CENTER; {AlignRight} + | RIGHT; {AlignCenter} + +source_clause: + | mr(SOURCE IS? | SOURCES ARE? {}) + el = source_operands rmo = rounded_phrase_opt + { ReportSource { source = el; rounding = rmo; } } + +(* Not rigorously exact (see P389), but too complicated to parse otherwise *) +source_operands: + | e = expression { [e] } + | el = ntl(arithmetic_term) { el } + +sum_clause: + | sl = nel(sum_phrase) + ro = io(pf(RESET ON? {}, report_data_name_or_final)) + rm = rounded_phrase_opt + { ReportSum { sum_of = sl; reset_on = ro; rounding = rm; } } + +sum_phrase: + | SUM OF? el = sum_operands il = lo(pf(UPON,names)) (* TODO: recov? *) + { { sum_operands = el; sum_upon_items = il } } + +(* Not sure which expressions are valid here (see P381) *) +sum_operands: + | e = expression { [e] } + | el = ntl(arithmetic_term) { el } + +let report_data_name_or_final := + | ~ = qualident; + | FINAL; {ReportFinal} + +let report_value_clause := + | mr(VALUE; IS?| VALUES; ARE?); ~ = literal; + +let present_when_clause := PRESENT; WHEN; ~ = condition; < > +let group_indicate_clause := GROUP; INDICATE? + +let report_occurs_clause [@context occurs_clause] := + | OCCURS; from = integer; to_ = io(pf(TO,integer)); TIMES?; + depending = ro(depending_phrase); + step = ro(step_phrase); + { ReportOccurs { from; to_; depending; step } } + + + +(* ---------- Rules specific to screens ---------- *) + +let screen_line_clause := + | LINE; NUMBER?; IS?; ~ = screen_line_column_clause; < > + +let screen_column_clause := + | or_(COL,COLUMN); NUMBER?; IS?; ~ = screen_line_column_clause; < > + +let screen_line_column_clause := + | ~ = ident_or_integer; + | pm = plus_or_minus; ii = ident_or_integer; {Relative (pm, ii)} + +let plus_or_minus := + | mr(PLUS | "+"); { Plus } + | mr(MINUS | "-"); { Minus } + +let blank_clause := + | BLANK; LINE; { Line } + | BLANK; SCREEN; { Screen } + +let erase_clause [@context erase_clause] := + | ERASE; mr(EOL | END?; OF?; LINE; {}); { EndOfLine } + | ERASE; mr(EOS | END?; OF?; SCREEN; {}); { EndOfScreen } + +let screen_attribute_clauses := + | ~ = nel(loc(screen_attribute_clause)); < > + +screen_attribute_clause: + | BELL { Bell } + | BLINK { Blink } + | HIGHLIGHT { Highlight } + | LOWLIGHT { Lowlight } + | REVERSE_VIDEO { ReverseVideo } + | UNDERLINE { Underline } + | FOREGROUND_COLOR IS? i = ident_or_integer { ForegroundColor i } + | BACKGROUND_COLOR IS? i = ident_or_integer { BackgroundColor i } + +// TODO: not really a list, should disambiguate later +let source_destination_clauses := + | ~ = nel(loc(source_destination_clause)); < > + +source_destination_clause: + | FROM ii = ident_or_literal { From ii } + | TO i = ident { To i } + | USING i = ident { Using i } + | VALUE IS? l = literal { Value l } + +let full_clause == FULL +let auto_clause == AUTO +let secure_clause == SECURE +let required_clause == REQUIRED +let screen_occurs_clause := OCCURS; ~ = integer; TIMES?; < > + + + + + + +(* -------------------- PROCEDURE DIVISION -------------------- *) + +procedure_division: + | PROCEDURE DIVISION + ul = ilo(pf(USING,rnel(loc(using_clause)))) + ro = ro(returning) (* +COB2002 *) + rl = ilo(raising_phrase) "." (* +COB2002 *) + dl = lo(declaratives) + sl = rl(loc(section_paragraph)) + { { procedure_using_clauses = ul; + procedure_returning = ro; + procedure_raising_phrases = rl; + procedure_declaratives = dl; + procedure_paragraphs = sl } } + +program_procedure_division: + | PROCEDURE DIVISION + ul = ilo(pf(USING,rnel(loc(using_clause)))) + ro = ro(returning) (* +COB2002 *) + rl = ilo(raising_phrase) "." (* +COB2002 *) + dl = lo(declaratives) + sl = section_paragraphs + { { procedure_using_clauses = ul; + procedure_returning = ro; + procedure_raising_phrases = rl; + procedure_declaratives = dl; + procedure_paragraphs = sl } } + +let object_procedure_division := (* +COB2002 *) + | PROCEDURE; DIVISION; "."; ~ = rl(loc(method_definition)); < > + +(* COB85: only USING ident+ (in the IPC module, P541) *) +let using_clause := + | io(BY?; REFERENCE); + ~ = nell(o = ibo(OPTIONAL); n = name; { { using_by_reference_optional = o; + using_by_reference = n } }); + %prec lowest + | BY?; VALUE; ~ = nell(name); %prec lowest + +(* Ambiguous, only class name may have factory *) +let raising_phrase := + | RAISING; ~ = nel(loc(f = bo(FACTORY; OF?); i = name; + { { raising_factory = f; raising = i} })); < > + (* exception / interface name / class name *) + +let declaratives := + | DECLARATIVES; "."; ~ = rnel(loc(decl_section_paragraph)); + END; DECLARATIVES; "."; < > + +(* Ambigous sections and paragraphs *) +let decl_section_paragraph := + | i = procedure_name_decl; + so = o(SECTION; ~ = ro(integer); "."; ~ = use_statement; < >); "."; + sl = rl(loc(sentence)); + { let io, us = match so with + | None -> None, None + | Some (io, us) -> io, Some us + in + { declarative_name = i; + declarative_segment = io; + declarative_use = us; + declarative_sentences = sl } } +(* segment number from 0 to 99, less than 50 *) + +(* Ambigous sections and paragraphs *) +let section_paragraphs := + | (* Empty *) { [] } + | ~ = rnel(loc(section_paragraph)); < > + | sl = loc(rnel(loc(sentence))); + tl = rl(loc(section_paragraph)); + { ({ paragraph_name = None; + paragraph_is_section = false; + paragraph_segment = None; + paragraph_sentences = ~&sl } &@<- sl) :: tl } + +let section_paragraph := + | i = procedure_name_decl; + s = o(SECTION; ~ = ro(integer); < >); "."; + sl = rl(loc(sentence)); + { let is_section, sg = match s with None -> false, None | Some v -> true, v in + { paragraph_name = Some i; + paragraph_is_section = is_section; + paragraph_segment = sg; + paragraph_sentences = sl } } +(* segment number from 0 to 99 *) + +let sentence := + (* | ~ = rl(loc(imperative_statement)); "."; < > *) + | stmts = rl (loc_result (imperative_statement)); "."; + { List.filter_map Result.to_option stmts } + + + +(* +procedural statement + +declarative statements actions that may be taken during processing of other statements + start by USE +imperative statements unconditional actions + unconditional action or conditional delimited by explicit termin +conditional statements actions depending on a condition + conditional phrase not terminated by explicit terminator + +imperative-statement = one or more imperative statements ended by separator DOT or + by any phrase associated with thet general format +*) + + +(* An imperative statement specifies an unconditional action to be taken by the + * runtime element or is a conditional statement that is delimited by its explicit + * scope terminator. *) +let imperative_statement [@recovery Result.Error "bad statement"] := + | ~ = unconditional_action; + | ~ = if_statement_explicit_term; + +(* A conditional statement specifies that the truth value of a condition is evaluated + * and used to determine subsequent flow of control. Any statement with a conditional + * phrase that is not terminated by its explicit scope terminator is a conditional statement. *) +let if_statement_explicit_term := + | ~ = if_statement; < > (* Conditional *) + +let imp_stmts [@recovery []] [@symbol ""] := + | stmts = nell (loc_result (imperative_statement)); +%prec lowest + { List.filter_map Result.to_option stmts } +(* prec annotation needed to solve a conflict involving IF and WRITE *) + + +let oterm_(X) == er(X | {} %prec no_term) (* optional terminators *) + + + + +(* ---------- Error handling rules ---------- *) + +(* COB85: the negative case must be after the positive case *) +let handler (X, NOT_X) == + | X; isl = imp_stmts; { { dual_handler_pos = isl; dual_handler_neg = [] } } + | NOT_X; isl = imp_stmts; { { dual_handler_pos = []; dual_handler_neg = isl } } + | (isl1, isl2) = + mr( X; isl1 = imp_stmts; NOT_X; isl2 = imp_stmts; {isl1, isl2} + | NOT_X; isl2 = imp_stmts; X; isl1 = imp_stmts; {isl1, isl2}); + { { dual_handler_pos = isl1; dual_handler_neg = isl2 } } + +let handler_opt (X, NOT_X) == + | (* epsilon *) { dual_handler_none } + | ~ = handler (X, NOT_X); < > + + +let on_overflow := OVERFLOW | ON_OVERFLOW + + +(* Used by CALL *) +let overflow_or_exception_handler == + | on_overflow; ~ = imp_stmts; (* &COB85 *) + | ~ = handler(on_exception,NOT_ON_EXCEPTION); +let on_exception := EXCEPTION | ON_EXCEPTION + +(* Used by READ *) +let at_end_or_invalid_key_handler == + | h = handler(at_end,NOT_AT_END); {ReadAtEnd, h} + | h = handler(INVALID_KEY,NOT_INVALID_KEY); {ReadInvalidKey, h} +let at_end := END | AT_END + +(* Used by WRITE *) +let end_of_page_or_invalid_key_handler == + | h = handler(at_eop,NOT_AT_EOP); {WriteAtEndOfPage, h} + | h = handler(INVALID_KEY,NOT_INVALID_KEY); {WriteInvalidKey, h} +let at_eop := EOP | AT_EOP | END_OF_PAGE + + + +(* ---------- Identifier and literals ---------- *) + + + +let name [@recovery dummy_name] [@symbol ""] := + | i = loc(WORD); < > +let names := ~ = rnel(name); < > + +let in_of := IN | OF + +let qualname [@recovery dummy_qualname] [@symbol ""] := + | n = name; %prec lowest {Name n: qualname} + | n = name; in_of; qdn = qualname; {Qual (n, qdn)} +let qualnames := ~ = rnel(qualname); < > +let reference == qualname + +let refmod == + | "("; leftmost = expression_no_all; ":"; length = ro(expression_no_all); ")"; + { { leftmost; length_opt = length } } + +let literal_int_ident := + | ~ = loc(DIGITS); < > + | EIGHTY_EIGHT; { with_loc "88" $sloc } + +let procedure_name_decl := + | ~ = loc(WORD_IN_AREA_A); < > + | ~ = procedure_name; < > + +let procedure_name := (* Can be present in paragraph or section name and level number *) + | ~ = name; < > + | ~ = literal_int_ident; < > + +let qualified_procedure_name := + | qdn = qualname; { qdn } + | li = literal_int_ident; { Name li } + | pn1 = literal_int_ident; in_of; + pn2 = literal_int_ident; { Qual (pn1, Name pn2) } + +let argument := + | e = expression_no_all; %prec lowest {ArgExpr e} + | OMITTED; {ArgOmitted} + +let arguments == + | "("; ")"; { [] } + | "("; al = rnel(argument); ")"; { al } + +let optional_arguments_list := + | (* Empty *) %prec lowest { [] } + | ~ = arguments; < > + +let subscript_first [@recovery SubSAll] [@symbol ""] [@cost 0] := + | ALL; {SubSAll} + | e = expression_no_all; {SubSExpr e} + | i = name; s = sign; offset = integer; {SubSIdx (i, s, offset): subscript} + +let subscript_following [@recovery SubSAll] [@symbol ""] [@cost 0] := + | ALL; {SubSAll} + | e = expression_par_unop; {SubSExpr e} + | i = name; s = sign; offset = integer; {SubSIdx (i, s, offset): subscript} + +let subscripts [@recovery []] [@symbol ""] [@cost 0] := + | "("; s = subscript_first; sl = rnel(subscript_following); ")"; { s::sl } + | "("; s = subscript_first; ")"; { [s] } + +let qualident [@symbol "<(qualified) identifier>"] [@recovery dummy_qualident] := + | ~ = qualident_refmod; < > + | ~ = qualident_no_refmod; < > + +let qualident_no_refmod := + | qdn = qualname; %prec lowest + { { ident_name = qdn; ident_refmod = None; ident_subscripts = [] } } + | qdn = qualname; sl = subscripts; %prec lowest + { { ident_name = qdn; ident_refmod = None; ident_subscripts = sl } } + +let qualident_refmod := + | qdn = qualname; rm = refmod; + { { ident_name = qdn; ident_refmod = Some rm; ident_subscripts = [] } } + | qdn = qualname; sl = subscripts; rm = refmod; + { { ident_name = qdn; ident_refmod = Some rm; ident_subscripts = sl } } + +(* Only for functions which name is also a keyword in COBOL *) +let intrinsic_function_name := + | LENGTH; { "LENGTH" } + | RANDOM; { "RANDOM" } + | REVERSE; { "REVERSE" } + | SIGN; { "SIGN" } + | SUM; { "SUM" } + +let function_name [@recovery dummy_name] [@symbol ""] := + | ~ = name; < > + | ~ = loc(intrinsic_function_name); < > + +let function_ident := + | FUNCTION; n = function_name; al = arguments; rm = io(refmod); %prec lowest + { { call_fun = n; call_args = al; call_refmod = rm } } + | FUNCTION; n = function_name; rm = io(refmod); %prec below_RPAR + { { call_fun = n; call_args = []; call_refmod = rm } } + +let inline_invocation := + | i = ident; "::"; l = literal; al = optional_arguments_list; + { { invoke_class = i; invoke_meth = l; invoke_args = al } } + +let object_view := + | i = ident; AS; s = object_view_spec; + { { object_view_ident = i; object_view_spec = s } } + +let object_view_spec == + | n = name; {ObjViewAmbiguous n: object_view_spec} + | ~ = name; ONLY; + | FACTORY; OF; ~ = name; + | FACTORY; OF; ~ = name; ONLY; + | UNIVERSAL; {ObjViewUniversal} + +let object_ref := + | EXCEPTION_OBJECT; {ExceptionObject} + | NULL; {Null} + | SELF; {Self} + | n = name; OF; SUPER; {Super (Some n)} + | SUPER; {Super None} + +let address := + | ADDRESS; OF; i = ident; {DataAddress i} + | ADDRESS; OF; PROGRAM; i = ident_or_literal; {ProgAddress i} + +let counter := + | k = counter_kind; %prec lowest { { counter_kind = k; counter_name = None } } + | k = counter_kind; in_of; n = name; { { counter_kind = k; counter_name = Some n } } + +let counter_kind == + | LINAGE_COUNTER; {LineageCounter} + | PAGE_COUNTER; {PageCounter} + | LINE_COUNTER; {LineCounter} + +let ident [@symbol ""] [@recovery dummy_ident] := + | q = qualident_no_refmod; {QualIdent q} (* Works for object property too *) + | f = function_ident; {InlineCall f} + | i = inline_invocation; {InlineInvoke i} + | o = object_view; {ObjectView o} + | r = object_ref; {ObjectRef r} (* Includes predefined address (NULL) *) + | a = address; {Address a} + | c = counter; {Counter c} + | q = qualident_refmod; {QualIdent q} (* Works for object property too *) + +let idents [@symbol ""] [@recovery []] := + | ~ = rnel(ident); < > + +let ident_or_literal + [@symbol ""] [@cost 0] + [@recovery Cobol_ast.UPCAST.ident_with_literal dummy_ident] := + | i = ident; %prec lowest { UPCAST.ident_with_literal i } + | l = literal; { UPCAST.literal_with_ident l } + +let figurative_constant [@recovery Zero] + [@symbol ""] := + | ~ = figurative_constant_no_all; < > + | ALL; l = nonnumeric_literal_no_all; { All l } +(*ALL symbolic-character (alphanum, national) (defined in SPECIAL-NAMES)*) + +let figurative_constant_no_all == + | ZERO; {Zero} (* alphanum, national, boolean, numeric *) + | SPACE; {Space} (* alphanum, national *) + | QUOTE; {Quote} (* alphanum, national *) + | LOW_VALUE; {LowValue} (* alphanum, national *) + | HIGH_VALUE; {HighValue} (* alphanum, national *) +(* | i = ident { Symbolic i } *) (*conflict in ident_or_xxx_literal*) + +let integers := ~ = rnel(integer); < > +let integer [@recovery "0"] + [@symbol ""] := + | ~ = DIGITS; < > + | ~ = SINTLIT; < > + | EIGHTY_EIGHT; {"88"} + +let fixedlit [@recovery fixed_zero] [@cost 10] + [@symbol ""] := + | (i, _, d) = FIXEDLIT; { Cobol_ast.fixed_of_strings i d } + +let floatlit [@recovery floating_zero] [@cost 10] + [@symbol ""] := + | (i, _, d, e) = FLOATLIT; { Cobol_ast.floating_of_strings i d e } + +let alphanum == (* TODO: attach interpretation (hex, etc) into AST *) + | a = ALPHANUM; { fst a } + | h = HEXLIT; { h } + +let literal [@recovery Integer "0"] [@symbol ""] := + | a = alphanum; {Alphanum a} + | n = NATLIT; {National n} + | b = BOOLIT; {Boolean b} + | i = integer; {Integer i} + | f = fixedlit; {Fixed f} + | f = floatlit; {Floating f} + | f = figurative_constant; {Fig f} + | l1 = nonnumeric_literal_no_all; "&"; + l2 = nonnumeric_literal_no_all; {Concat (l1, l2): literal} + +(* +literal_no_all: + | l = elementary_literal { l } + | f = figurative_constant_no_all { Figurative (f) } + | l1 = nonnumeric_literal_no_all "&" + l2 = nonnumeric_literal_no_all { Concat (l1, l2) : literal } +; +*) + +(* concat : both operands shall be of the same class *) +(* result of concatenation shall be less than 8191 character positions *) +(* was 160 in older standard (COB85 ?) *) +(* note : & should be between spaces *) + + + + +let numeric_literal [@symbol ""] := + | i = integer; { Integer i : numlit } + | f = fixedlit; { Fixed f } + | f = floatlit; { Floating f } + | ZERO; { NumFig Zero } +(* Note: numeric literals do NOT allow figurative constants with ALL *) + + + + +let elementary_string_literal == + | a = alphanum; { Alphanum a } + | n = NATLIT; { National n : strlit } + +let string_literal [@symbol ""] := + | l = elementary_string_literal; { l } + | f = figurative_constant; { Fig f } + | l1 = string_literal_no_all; "&"; + l2 = string_literal_no_all; { StrConcat (l1, l2) : strlit } + +let string_literal_no_all [@symbol ""] := + | l = elementary_string_literal; { l: strlit } + | f = figurative_constant_no_all; { Fig f } + | l1 = string_literal_no_all; "&"; + l2 = string_literal_no_all; { StrConcat (l1, l2) : strlit } + + + + +elementary_string_or_int_literal: + | a = alphanum { Alphanum a } + | n = NATLIT { National n } + | i = integer { Integer i } + +string_or_int_literal: + | l = elementary_string_or_int_literal { l } + | f = figurative_constant { Fig f } + | l1 = string_literal_no_all "&" + l2 = string_literal_no_all { StrConcat (l1, l2) : strlit_or_intlit } + +(* +string_or_int_literal_no_all: + | l = elementary_string_or_int_literal { l } + | f = figurative_constant_no_all { Figurative (f) } + | l1 = string_or_int_literal_no_all "&" + l2 = string_or_int_literal_no_all { Concat (l1, l2) : strlit_or_intlit } +*) + +elementary_nonnumeric_literal: + | a = alphanum { Alphanum a } + | n = NATLIT { National n } + | b = BOOLIT { Boolean b } + +nonnumeric_literal: + | l = elementary_nonnumeric_literal { l } + | f = figurative_constant { Fig f } + | l1 = nonnumeric_literal_no_all "&" + l2 = nonnumeric_literal_no_all { Concat (l1, l2): nonnumlit } + +nonnumeric_literal_no_all: + | l = elementary_nonnumeric_literal { l } + | f = figurative_constant_no_all { Fig f } + | l1 = nonnumeric_literal_no_all "&" + l2 = nonnumeric_literal_no_all { Concat (l1, l2): nonnumlit } + + + + + +(* Used in many *) +let qualname_or_literal := + | n = qualname; { UPCAST.qualname_with_literal n } + | l = literal; { UPCAST.literal_with_qualdatname l } + +(* Used in ADD, DIVIDE, MULTIPLY, PERFORM, SUBTRACT *) + +let ident_or_numeric := + | i = ident; { UPCAST.ident_with_numeric i } + | l = numeric_literal; { UPCAST.numeric_with_ident l } +let idents_or_numerics == ~ = rnel(ident_or_numeric); < > + +(* Used in CALL *) +let name_or_string := + | i = name; { Name i } + | s = string_literal; { UPCAST.string_with_name s } + +let ident_or_string := + | i = ident; %prec below_RPAR { UPCAST.ident_with_string i } + | s = string_literal; { UPCAST.string_with_ident s } +let idents_or_strings == ~ = rnel(ident_or_string); < > + +(* UNSTRING *) +(* These statements explicitly forbid the ALL literal, + which (by chance) helps solve some conflicts *) + +let ident_or_string_no_all := + | i = ident; { UPCAST.ident_with_string i } + | l = string_literal_no_all; { UPCAST.string_with_ident l } + +(* INSPECT, STRING, TRANSFORM *) + +let ident_or_nonnumeric := + | i = ident; { UPCAST.ident_with_nonnum i } + | l = nonnumeric_literal; { UPCAST.nonnum_with_ident l } + +(* INSPECT, STRING, TRANSFORM *) +(* These statements explicitly forbid the ALL literal, + which (by chance) helps solve some conflicts *) +let ident_or_nonnumeric_no_all := + | i = ident; { UPCAST.ident_with_nonnum i } + | l = nonnumeric_literal_no_all; { UPCAST.nonnum_with_ident l } + +(* Used in ENABLE, DISABLE *) +let name_or_alphanum := + | i = name; { Name i } + | a = alphanum; { Alphanum a } + +let qualname_or_alphanum := + | n = qualname; { UPCAST.qualname_with_alphanum n } + | a = alphanum; { Alphanum a } + +let ident_or_alphanum := + | i = ident; { UPCAST.ident_with_alphanum i } + | a = alphanum; { Alphanum a } + +(* Used in line_number (ACCEPT, DISPLAY) and PERFORM *) +let qualname_or_integer := + | n = qualname; { UPCAST.qualname_with_integer n } + | i = integer; { Integer i } + +let ident_or_integer := + | i = ident; { UPCAST.ident_with_integer i } + | ZERO; { NumFig Zero } + | i = integer; { Integer i : ident_or_intlit } + +(* ---------- Expressions ---------- *) + +expression_par_unop: (* arith or boolean *) + | e1 = expression_par_unop "+" e2 = expr_term { Binop (e1, BPlus, e2) } + | e1 = expression_par_unop "-" e2 = expr_term { Binop (e1, BMinus, e2) } + | e = expr_term_par_unop { e } + (* but not both ALL literal *) + (* when a +/- follows an arith exp or ident, it must be between () *) + +expr_term_par_unop: + | e1 = expr_term_par_unop o = binop e2 = expr_factor { Binop (e1, o, e2) } + | e = expr_factor_par_unop { e } + +expr_factor_par_unop: + | e1 = expr_unary_par "**" e2 = expr_factor { Binop (e1, BPow, e2) } + | e = expr_unary_par { e } + +let expr_unary_par == atomic_expression_no_all + +let expression [@recovery Atom (Fig Zero)] [@symbol ""] [@cost 0] := + (* arith or boolean *) + | e1 = expression; "+"; e2 = expr_term; { Binop (e1, BPlus, e2) } + | e1 = expression; "-"; e2 = expr_term; { Binop (e1, BMinus, e2) } + | e = expr_term; { e } + (* but not both ALL literal *) + (* when a +/- follows an arith exp or ident, it must be between () *) + +expr_term: + | e1 = expr_term o = binop e2 = expr_factor { Binop (e1, o, e2) } + | e = expr_factor { e } + +expr_factor: + | e1 = expr_unary "**" e2 = expr_factor { Binop (e1, BPow, e2) } + | e = expr_unary { e } + +expr_unary: + | e = atomic_expression { e } + | o = unop e = atomic_expression { Unop (o, e) } + +let atomic_expression [@recovery dummy_expr] [@symbol ""] := + | e = arithmetic_term; { e } + | "("; e = expression; ")"; { e } (* arith or boolean *) + +arithmetic_term: + | i = ident { Atom (UPCAST.ident_with_literal i) } (* numeric or boolean *) + | i = integer { Atom (Integer i) } + | f = fixedlit { Atom (Fixed f) } + | f = floatlit { Atom (Floating f) } + | b = BOOLIT { Atom (Boolean b) } (* boolean *) + | f = figurative_constant { Atom (Fig f) } (* numeric or boolean (NB: or strlits) *) + | a = alphanum { Atom (Alphanum a) } (* NB: quick relaxation for now *) + +let expression_no_all [@recovery dummy_expr] [@symbol ""] (* [@cost 0] *):= + | e1 = expression_no_all; "+"; e2 = expr_term_no_all; { Binop (e1, BPlus, e2) } + | e1 = expression_no_all; "-"; e2 = expr_term_no_all; { Binop (e1, BMinus, e2) } + | e = expr_term_no_all; { e } + (* but not both ALL literal *) + (* when a +/- follows an arith exp or ident, it must be between () *) + +expr_term_no_all: + | e1 = expr_term_no_all o = binop e2 = expr_factor_no_all { Binop (e1, o, e2) } + | e = expr_factor_no_all { e } + +expr_factor_no_all: + | e1 = expr_unary_no_all "**" e2 = expr_factor_no_all { Binop (e1, BPow, e2) } + | e = expr_unary_no_all { e } + +let expr_unary_no_all == + | e = atomic_expression_no_all; { e } + | o = unop; e = atomic_expression_no_all; { Unop (o, e) } + +let atomic_expression_no_all [@recovery dummy_expr] [@symbol ""] := + | e = arithmetic_term_no_all; { e } + | "("; e = expression_no_all; ")"; { e } (* arith or boolean *) + +arithmetic_term_no_all: + | i = ident { Atom (UPCAST.ident_with_literal i) } (* numeric or boolean *) + | i = integer { Atom (Integer i) } + | f = fixedlit { Atom (Fixed f) } + | f = floatlit { Atom (Floating f) } + | b = BOOLIT { Atom (Boolean b) } (* boolean *) + | a = alphanum { Atom (Alphanum a) } (* NB: quick relaxation for now *) + | f = figurative_constant_no_all { Atom (Fig f) } (* numeric or boolean (NB: or strlits) *) + +%inline binop: + | "*" { BMul } + | "/" { BDiv } + | B_AND { BAnd } + | B_OR { BOr } + | B_XOR { BXor } + +%inline unop: + | "+" { UPlus } + | "-" { UMinus } + | B_NOT { UNot } + +(* ---------- Conditions ---------- *) + + + +condition: + | complex_condition { $1 } + +complex_condition: + | nonrel_condition { $1 } + | flat_relation_condition %prec lowest { $1 } + | complex_condition logop complex_condition { Logop ($1, $2, $3) } + +%inline logop: + | AND { LAnd } + | OR { LOr } + +%inline flat_relation_condition: + | n = ibo(NOT) c = relation_condition + suff = io (pair (logop, flat_combination_operand)) + { expand_relation_condition n c suff } + +nonrel_condition: + | n = ibo(NOT) e = expression %prec lowest { neg_cond n @@ Expr e } + | n = ibo(NOT) c = extended_condition { neg_cond' n c } + | n = ibo(NOT) "(" c = complex_condition ")" { neg_cond' n c } + +flat_combination_operand: + | r = io(relop) e = expression { FlatAmbiguous (r, e) } + | NOT e = expression { FlatNotExpr e } + | n = ibo(NOT) c = relation_condition { FlatRel (n, c) } + | n = ibo(NOT) c = extended_condition { FlatOther (neg_cond' n c) } + | n = ibo(NOT) "(" c = complex_condition ")" { FlatOther (neg_cond' n c) } + | flat_combination_operand logop flat_combination_operand + { FlatComb ($1, $2, $3) } + +relation_condition: + | expression relop expression { $1, $2, $3 } + +extended_condition: + | e = expression io(IS) n = bo(NOT) c = class_condition + { neg_cond n @@ ClassCond (e, c) } (* exp = ident *) + | e = expression io(IS) n = bo(NOT) s = sign_condition + { neg_cond n @@ SignCond (e, s) } (* exp = arith exp *) + | e = expression io(IS) n = bo(NOT) OMITTED + { neg_cond n @@ Omitted e } (* exp = ident *) + +relop [@recovery Eq] [@symbol ""]: + | io(IS) n = ibo(NOT) GREATER THAN? + | io(IS) n = ibo(NOT) ">" { if n then Le else Gt } + | io(IS) n = ibo(NOT) LESS THAN? + | io(IS) n = ibo(NOT) "<" { if n then Ge else Lt } + | io(IS) n = ibo(NOT) EQUAL TO? + | io(IS) n = ibo(NOT) "=" { if n then Ne else Eq } + | io(IS) n = ibo(NOT) "<>" { if n then Eq else Ne } + | io(IS) n = ibo(NOT) GREATER THAN? OR EQUAL TO? + | io(IS) n = ibo(NOT) ">=" { if n then Lt else Ge } + | io(IS) n = ibo(NOT) LESS THAN? OR EQUAL TO? + | io(IS) n = ibo(NOT) "<=" { if n then Gt else Le } + +class_condition: + | i = name { AlphabetOrClass i } + | c = class_condition_no_ident { c } + +class_condition_no_ident [@recovery ClassNumeric]: + | ALPHABETIC { Alphabetic } + | ALPHABETIC_LOWER { AlphabeticLower } + | ALPHABETIC_UPPER { AlphabeticUpper } + | BOOLEAN { ClassBoolean } + | FARTHEST_FROM_ZERO { FarthestFromZero } + | FLOAT_INFINITY { FloatInfinity } + | FLOAT_NOT_A_NUMBER { FloatNotANumber } + | FLOAT_NOT_A_NUMBER_QUIET { FloatNotANumberQuiet } + | FLOAT_NOT_A_NUMBER_SIGNALING { FloatNotANumberSignaling } + | IN_ARITHMETIC_RANGE { InArithmeticRange } + | NEAREST_TO_ZERO { NearestToZero } + | NUMERIC { ClassNumeric } + +sign_condition: + | s = sign_condition_no_zero { s } + | ZERO { SgnZero } + +sign_condition_no_zero [@recovery SgnPositive]: + | POSITIVE { SgnPositive } + | NEGATIVE { SgnNegative : signz } + + + +(* ---------- Rules common to several statements ---------- *) + + + +(* ACCEPT, DISPLAY *) + +let position := + | l = line_number; { LinePosition l } + | c = column_number; { ColumnPosition c } + | l = line_number; c = column_number; { LineColumnPosition (l, c) } + | c = column_number; l = line_number; { LineColumnPosition (l, c) } + +let line_number := + | LINE; NUMBER?; ~ = ident_or_integer; < > +(* integer must be unsigned *) + +let column_number := + | or_(COL,COLUMN); NUMBER?; ~ = ident_or_integer; < > +(* integer must be unsigned *) + + + +(* ADD, COMPUTE, DIVIDE, MULTIPLY, SUBTRACT *) + +let rounded_ident := + | i = ident; rm = rounded_phrase_opt; + { { rounded_ident = i; rounded_rounding = rm} } +let rounded_idents == ~ = rnel(rounded_ident); < > + +let rounded_phrase_opt := + | (* epsilon *) {RoundingNotAny} (* = ROUNDED MODE TRUNCATION *) + | ~ = rounded_phrase; < > + +let rounded_phrase [@context rounded_phrase] := + | ROUNDED; {RoundingDefault} (* use default rounding *) + | ROUNDED; MODE; IS?; ~ = rounding_mode; + +let rounding_mode := + | AWAY_FROM_ZERO; {AwayFromZero} + | NEAREST_AWAY_FROM_ZERO; {NearestAwayFromZero} + | NEAREST_EVEN; {NearestEven} + | NEAREST_TOWARD_ZERO; {NearestTowardZero} + | PROHIBITED; {TowardGreater} + | TOWARD_GREATER; {TowardLesser} + | TOWARD_LESSER; {Truncation} + | TRUNCATION; {Prohibited} + + + +(* ALLOCATE, CALL, INVOKE, Procedure division header *) + +let returning := RETURNING; ~ = loc(ident); < > + + + +(* CALL, INVOKE *) +(* Ambiguous & different between standards *) +(* +COB85: + (BY REFERENCE)? identifier... + BY CONTENT identifier... +COB2002: + (BY REFERENCE)? identifier/OMITTED + (BY CONTENT)? identifier/literal/expression + (BY VALUE)? identifier/literal/expression +*) + +let using_by := + | b = call_using_by?; e = arithmetic_term; + { { call_using_by = b; + call_using_expr = Some e } } (* COB85: ident, COB2002: exp *) + | b = call_using_by?; OMITTED; + { { call_using_by = b; + call_using_expr = None } } (* +COB2002 *) + +let call_using_by [@recovery CallUsingByReference] := + | BY?; REFERENCE; {CallUsingByReference} + | BY?; CONTENT; {CallUsingByContent} + | BY?; VALUE; {CallUsingByValue} (* +COB2002 *) + + + +(* DELETE, OPEN, READ, REWRITE, WRITE *) + +let retry_phrase [@context retry_phrase] := + | RETRY; ~ = expression; TIMES; + | RETRY; FOR; ~ = expression; SECONDS; + | RETRY; FOREVER; {RetryForever} + + + +(* DISABLE, ENABLE *) + +let with_key := + | WITH?; KEY; ~ = ident_or_alphanum; < > + +let mcs_kind := + | INPUT; TERMINAL?; {MCSInput} + | I_O; TERMINAL; {MCSInputOutput} + | OUTPUT; {MCSOutput} + +let mcs_command := + | io = mcs_kind; i = name; iao = io(with_key); + { { mcs_command_kind = io; + mcs_command_target = i; + mcs_command_key = iao } } + + +(* EXIT, GOBACK *) + +let raising_exception := (* COB2002+ *) + | RAISING; i = ident; {RaisingIdent i} + | RAISING; EXCEPTION; i = name; {RaisingException i} + | RAISING; LAST; EXCEPTION; {RaisingLastException} + | RAISING; LAST; %prec lowest {RaisingLastException} (* unexplainable conflict using option *) + + + +(* MERGE, SORT *) + +let on_key := + | ON?; d = sort_direction; KEY?; il = qualnames; + { { sort_key_direction = d; sort_key_names = il } } + (* | ON?; DESCENDING; KEY?; il = qualnames; *) + (* { { sort_key_direction = SortDescending; sort_key_names = il } } *) + +let collating_sequence_phrase := + | COLLATING?; SEQUENCE; ~ = alphabet_specification; < > + +let alphabet_specification := + | IS?; i = name; io = ro(name); { { alphanumeric = Some i; national = io } } + | i = cs_alphanumeric; { { alphanumeric = Some i; national = None } } + | i = cs_national; { { alphanumeric = None; national = Some i } } + | (ia, in_) = mr( ia = cs_alphanumeric; in_ = cs_national; {ia, in_} + | in_ = cs_national; ia = cs_alphanumeric; {ia, in_}); + { { alphanumeric = Some ia; national = Some in_ } } + +let cs_alphanumeric := FOR; ALPHANUMERIC; IS?; ~ = name; < > +let cs_national := FOR; NATIONAL; IS?; ~ = name; < > + +let output_or_giving := + | OUTPUT; PROCEDURE; IS?; i = procedure_name; io = ro(pf(THROUGH,procedure_name)); + { OutputProcedure { procedure_start = i; procedure_end = io } } + | GIVING; ~ = names; + + + +(* OPEN, USE *) + +let open_mode := + | INPUT; {OpenInput} + | OUTPUT; {OpenOutput} + | I_O; {OpenInputOutput} + | EXTEND; {OpenExtend} + + +(* PERFORM, SEND *) + +let after_or_before := + | AFTER; {After} + | BEFORE; {Before} + + +(* READ, REWRITE, WRITE *) + +let with_lock := + | /*%prec lowest*/ {None} + | io(WITH); LOCK; {Some true} + | io(WITH); NO; LOCK; {Some false} + + +(* ---------- Rules specific to a single statement ---------- *) + + + +(* ACCEPT STATEMENT *) + +(* TODO: FROM and TO and USING clauses *) +%public let unconditional_action := ~ = accept_statement; +accept_statement [@context accept_stmt]: + | ACCEPT i = loc(ident) end_accept + { AcceptGeneric i } + | ACCEPT i1 = loc(ident) FROM i2 = name end_accept + { AcceptFromDevice { item = i1; device_item = i2 } } + | ACCEPT i = loc(ident) FROM ddt = date_day_time end_accept + { AcceptTemporal { item = i; date_time = ddt } } + | ACCEPT i = name MESSAGE? COUNT end_accept (* -COB2002 *) + { AcceptMsgCount i } + | ACCEPT i = name AT p = position (* +COB2002 *) + h = handler_opt(on_exception,NOT_ON_EXCEPTION) end_accept + { AcceptAtScreen { item = i; + position = Some p; + on_exception = h; } } + | ACCEPT i = name + h = handler(on_exception,NOT_ON_EXCEPTION) end_accept (* +COB2002 *) + { AcceptAtScreen { item = i; + position = None; + on_exception = h; } } + | ACCEPT item = loc(ident) (* MF *) + FROM ENVIRONMENT env_item = loc(ident_or_nonnumeric_no_all) + on_exception = handler_opt(on_exception,NOT_ON_EXCEPTION) end_accept + { AcceptFromEnv { item; env_item; on_exception } } + +let end_accept := oterm_(END_ACCEPT) + +let date_day_time := + | DATE; y = bo(YYYYMMDD); {Date y} (* YYYYMMDD +COB2002 *) + | DAY; y = bo(YYYYDDD); {Day y} (* YYYYDDD +COB2002 *) + | DAY_OF_WEEK; {DayOfWeek} + | TIME; {Time} + + + +(* ADD STATEMENT *) + +%public let unconditional_action := ~ = add_statement; < > +add_statement: + | ADD inl = idents_or_numerics TO irl = rounded_idents + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR) end_add + { Add { basic_arith_operands = + ArithSimple { sources = inl; targets = irl }; + basic_arith_on_size_error = h } } + | ADD inl = idents_or_numerics TO in_ = ident_or_numeric + GIVING irl = rounded_idents + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR) end_add + { Add { basic_arith_operands = + ArithGiving { sources = inl; + to_or_from_item = in_; + targets = irl }; + basic_arith_on_size_error = h } } + | ADD inl = idents_or_numerics (* Same as above without 'TO' *) + GIVING irl = rounded_idents + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR) end_add + { let in_, inl = split_last inl in + Add { basic_arith_operands = + ArithGiving { sources = inl; + to_or_from_item = in_; + targets = irl }; + basic_arith_on_size_error = h } } + | ADD CORRESPONDING i = qualname TO ir = rounded_ident + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR) end_add + { Add { basic_arith_operands = + ArithCorresponding { source = i; target = ir }; + basic_arith_on_size_error = h } } + +let end_add := oterm_(END_ADD) + + +(* ALLOCATE STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = allocate_statement; < > +let allocate_statement [@context allocate_stmt] := + | ALLOCATE; e = expression; CHARACTERS; ib = bo(INITIALIZED); r = returning; + { Allocate { allocate_kind = AllocateCharacters e; + allocate_initialized = ib; + allocate_returning = Some r } } + | ALLOCATE; i = name; ib = bo(INITIALIZED); ro = ro(returning); + { Allocate { allocate_kind = AllocateDataItem i; + allocate_initialized = ib; + allocate_returning = ro } } + + + +(* ALTER STATEMENT (~COB85, -COB2002) *) + +%public let unconditional_action := ~ = alter_statement; < > +let alter_statement := + | ALTER; ~ = l(loc(i1 = qualified_procedure_name; TO; o(PROCEED; TO); + i2 = qualified_procedure_name; + { { alter_source = i1; alter_target = i2 } })); + + + +(* CALL STATEMENT *) + +%public let unconditional_action := ~ = call_statement; < > +let call_statement := + | CALL; cp = call_prefix; ul = lo(pf(USING,rnel(loc(using_by)))); + ro = ro(returning); oeho = io(overflow_or_exception_handler); + oterm_(END_CALL); + { Call { call_prefix = cp; + call_using = ul; + call_returning = ro; + call_error_handler = oeho } } + +let call_prefix := + | i = ident_or_string; + | ian = ident_or_string; AS; in_ = ident_or_nested; + { CallProto { called = Some ian; prototype = in_ } } + | NESTED; + { CallProto { called = None; prototype = CallProtoNested } } + +let ident_or_nested := + | ~ = ident; + | NESTED; {CallProtoNested} + +(* CANCEL STATEMENT (+COB85) *) + +%public let unconditional_action := ~ = cancel_statement; < > +let cancel_statement := + | CANCEL; ~ = idents_or_strings; + + + +(* CLOSE STATEMENT *) + +%public let unconditional_action := ~ = close_statement; < > +let close_statement := + | CLOSE; ~ = nel(i = name; cf = ro(close_format); + { { close_item = i; close_format = cf } }); + +let close_format := + | or_(REEL,UNIT); ~ = bo(FOR?; REMOVAL); + | WITH?; NO; REWIND; {CloseWithNoRewind} + | WITH?; LOCK; {CloseWithLock} + + + +(* COMPUTE STATEMENT *) + +%public let unconditional_action := ~ = compute_statement; < > +let compute_statement := + | COMPUTE; irl = rounded_idents; "="; e = expression; + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); + oterm_(END_COMPUTE); + { Compute { compute_targets = irl; compute_expr = e; + compute_on_size_error = h } } +(* COB2002: added boolean form with bool_expr and no rounded (and no err) *) + + +(* CONTINUE STATEMENT *) + +%public let unconditional_action := ~ = continue_statement; < > +let continue_statement := CONTINUE; {Continue} + + + +(* DELETE STATEMENT *) + +%public let unconditional_action := ~ = delete_statement; < > +let delete_statement := + | DELETE; i = name; RECORD?; ro = ro(retry_phrase); + h = handler_opt(INVALID_KEY,NOT_INVALID_KEY); + oterm_(END_DELETE); + { Delete { delete_targets = i; delete_retry = ro; + delete_on_invalid_key = h} } +(* retry: +COB2002 *) + + + +(* DISABLE STATEMENT (+COB85, -COB2002) *) + +%public let unconditional_action := ~ = disable_statement; < > +let disable_statement := + | DISABLE; ~ = mcs_command; + + + +(* DISPLAY STATEMENT *) + +(* TODO: FROM and USING clauses *) +%public let unconditional_action := ~ = display_statement; +let display_statement := + (* Ambiguous case *) + | DISPLAY; i = ident_or_literal; end_display; + { DisplayDefault i } + + (* Device case (disambiguated) *) + | DISPLAY; i = ident_or_literal; d = display_device_disambiguated; end_display; + { let ill, io, wna = d in + DisplayDevice { displayed_items = i :: ill; + upon = io; + advancing = wna } } + + (* Screen case (disambiguated) *) (* +COB2002 *) + | DISPLAY; i = name; dsd = display_screen_disambiguated; end_display; + { DisplayScreen { screen_item = i; + position = fst dsd; + on_exception = snd dsd; } } + +let end_display := oterm_(END_DISPLAY) + +let display_device_disambiguated == + | ~ = rnel(ident_or_literal); ~ = ro(loc(upon)); ~ = ibo(with_no_advancing); < > + | i = loc(upon); wna = ibo(with_no_advancing); { [], Some i, wna } + | with_no_advancing; { [], None, true } + +let upon := + | UPON; ~ = name; + | UPON; ~ = loc(display_device_mnemonic); +let display_device_mnemonic == + | ENVIRONMENT_NAME; {DisplayDeviceEnvName} + | ENVIRONMENT_VALUE; {DisplayDeviceEnvValue} + | ARGUMENT_NUMBER; {DisplayDeviceArgNumber} + | COMMAND_LINE; {DisplayDeviceCommandLine} +let with_no_advancing := io(WITH); NO; ADVANCING + +let display_screen_disambiguated == + | AT; p = position; h = handler_opt(on_exception,NOT_ON_EXCEPTION); { Some p, h } + | h = handler(on_exception,NOT_ON_EXCEPTION); { None, h } + + +(* DIVIDE STATEMENT *) +(* Slightly ambiguous: INTO ident ? *) +(* Also deal with remainder -> single ir TODO *) + +%public let unconditional_action := ~ = divide_statement; +divide_statement: + | DIVIDE in_ = ident_or_numeric INTO irl = rounded_idents + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); end_divide + { { divide_operands = DivideInto { divisor = in_; dividends = irl }; + divide_on_size_error = h } } + | DIVIDE in1 = ident_or_numeric INTO in2 = ident_or_numeric + GIVING irl = rounded_idents ro = ro(pf(REMAINDER,ident)) + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); (* no remainder: single ir *) + end_divide + { { divide_operands = DivideGiving { divisor = in1; + dividend = in2; + giving = irl; + into = true; + remainder = ro }; + divide_on_size_error = h } } + | DIVIDE in1 = ident_or_numeric BY in2 = ident_or_numeric + GIVING irl = rounded_idents ro = ro(pf(REMAINDER,ident)) + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); (* no remainder: single ir *) + end_divide + { { divide_operands = DivideGiving { dividend = in1; + divisor = in2; + giving = irl; + into = false; + remainder = ro }; + divide_on_size_error = h } } + +let end_divide := oterm_(END_DIVIDE) + + +(* ENABLE STATEMENT (+COB85, -COB2002) *) + +%public let unconditional_action := ~ = enable_statement; < > +(* let enable_statement := *) +(* | ENABLE; io = input_output; i = name; iao = io(with_key); *) +(* { Enable { enable_kind = io; enable_target = i; enable_key = iao} } *) + +let enable_statement := + | ENABLE; ~ = mcs_command; + + +(* ENTER STATEMENT (~COB85, -COB2002) *) + +%public let unconditional_action := ~ = enter_statement; < > +let enter_statement := + | ENTER; i = name; io = ro(name); "."; + { Enter { enter_language = i; enter_routine = io} } + + + +(* EVALUATE STATEMENT (+COB85) *) +(* COBOL 85 and COBOL 2002 differ significantly *) +(* Particularly ambiguous, especially the selection subjects/objects *) +(* + +selection subject: + + when ident is numeric or boolean of length 1, it is really + considered as an ident and not as an arith/bool expression + +selection object: + +partial_exp = sequence of cobol words starting with + a relational operator, + a class condition without identifier, + a sign condition without identifier, + a sign condition without the arithmetic expression + +selection_subject followed by partial_exp = conditional exp + +Partial exp = ident/zero is ambiguous, could be + NOT? class_condition / sign_condition (partial exp) + NOT? expression (ident/zero) +*) + +%public let unconditional_action := ~ = evaluate_statement; < > +let evaluate_statement := + | EVALUATE; ssl = selection_subjects; wl = nell(when_phrase); + isl = when_other; oterm_(END_EVALUATE); + { Evaluate { eval_subjects = ssl; + eval_branches = wl; + eval_otherwise = isl; } } + +let selection_subjects := + | ss = selection_subject; { [ss] } + | ss = selection_subject; ALSO; ssl = selection_subjects; { ss :: ssl } + +let selection_subject := + | c = condition; {Subject c} (* also arith/bool expr *) + | TRUE; {SubjectConst true} + | FALSE; {SubjectConst false} + +let selection_objects := + | so = selection_object; { [so] } + | so = selection_object; ALSO; sol = selection_objects; { so :: sol } + +let selection_object := + | c = condition; {SelCond c} (* also arith/bool exp*) + | ~ = range_expression; < > + | ~ = partial_expression; < > (* +COB2002 *) + | TRUE; {SelConst true} + | FALSE; {SelConst false} + | ANY; {SelAny: selection_object} + +let range_expression := + | b = ibo(NOT); i1 = expression; THROUGH; + i2 = expression; i = ro(pf(IN,name)); + { SelRange { negated = b; start = i1; stop = i2; alphabet = i } } + +let partial_expression := + | o = relop; e = expression; + { SelRelation { relation = o; expr = e } } (* relation (general, bool, pointer) *) + | IS; n = bo(NOT); c = class_condition; + { SelClassCond { negated = n; class_specifier = c } } (* class *) (* exp = ident *) + | n = bo(NOT); c = class_condition_no_ident; + { SelClassCond { negated = n; class_specifier = c } } (* class *) (* exp = ident *) + | IS; n = bo(NOT); s = sign_condition; + { SelSignCond { negated = n; sign_specifier = s } } (* sign *) (* exp = arith exp *) + | n = bo(NOT); s = sign_condition_no_zero; + { SelSignCond { negated = n; sign_specifier = s } } (* sign *) (* exp = arith exp *) + | io(IS); n = bo(NOT); OMITTED; + { SelOmitted { negated = n } } (* omitted *) (* exp = ident *) + +let when_phrase := + | wl = rnel(when_selection_objects); isl = imp_stmts; + { {eval_selection = wl; eval_actions = isl} } + +let when_selection_objects := WHEN; ~ = selection_objects; < > + +let when_other := + | %prec lowest { [] } + | WHEN; OTHER; ~ = imp_stmts; < > + + + +(* EXIT STATEMENT *) + +%public let unconditional_action := ~ = exit_statement; < > +let exit_statement [@context exit_stmt] := + | EXIT; ~ = exit_spec; +let exit_spec [@recovery ExitSimple] := + | %prec lowest { ExitSimple } + | PROGRAM; ro = ro(raising_exception); { ExitProgram ro } + | METHOD; ro = ro(raising_exception); { ExitMethod ro } (* COB2002+ *) + | FUNCTION; ro = ro(raising_exception); { ExitFunction ro } (* COB2002+ *) + | PERFORM; c = bo(CYCLE); { ExitPerform c } (* COB2002+ *) + | PARAGRAPH; { ExitParagraph } (* COB2002+ *) + | SECTION; { ExitSection } (* COB2002+ *) + + + +(* FREE STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = free_statement; < > +let free_statement := + | FREE; ~ = names; + + +(* GENERATE STATEMENT (+COB85, -COB2002) *) + +%public let unconditional_action := ~ = generate_statement; < > +let generate_statement := + | GENERATE; ~ = name; + + + +(* GO TO STATEMENT *) + +%public let unconditional_action := ~ = go_to_statement; < > +let go_to_statement := + | GO; TO?; i = qualified_procedure_name; + { GoTo i } + | GO; TO?; il = rnel(qualified_procedure_name); + DEPENDING; ON?; i = ident; + { GoToDepending { goto_depending_targets = il; goto_depending_on = i; } } + | GO; TO?; (* COB85; obsolete; should be sole statement of paragraph *) + { LoneGoTo } + + + +(* GOBACK STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = goback_statement; < > +let goback_statement := + | GOBACK; ~ = ro(raising_exception); + + + +(* IF STATEMENT *) + +let if_statement := + | IF; c = condition; THEN?; ib = if_body; oterm_(END_IF); + { let sn, sno = ib in + If {condition = c; then_branch = sn; else_branch = sno} } +(* COB2002: END IF mandatory on ELSE, NEXT STATEMENT archaic *) + +let if_body := + | isl = imp_stmts; %prec lowest { Statements isl, None } + | isl = imp_stmts; ep = else_phrase; { Statements isl, Some ep } + | NEXT; SENTENCE; %prec lowest { NextSentence, None } + | NEXT; SENTENCE; ep = else_phrase; { NextSentence, Some ep } + +let else_phrase := + | ELSE; NEXT; SENTENCE; { NextSentence } + | ELSE; isl = imp_stmts; { Statements isl } + + +(* INITIALIZE STATEMENT (+COB85) *) + +%public let unconditional_action := ~ = initialize_statement; < > +let initialize_statement := + | INITIALIZE; il = idents; + wf = ibo(io(WITH); FILLER); (* +COB2002 *) + co = io(category_to_value); (* +COB2002 *) + rl = ilo(then_replacing); + d = ibo(THEN?; TO?; DEFAULT); + { Initialize { + init_items = il; + init_filler = wf; + init_category = co; + init_replacings = rl; + init_to_default = d; } } + +let category_to_value := + | ALL; TO?; VALUE; {InitAll} + | ~ = init_data_category; TO?; VALUE; + +let then_replacing := + | THEN?; REPLACING; + ~ = nel(c = init_data_category; DATA?; BY; il = ident_or_literal; + { { init_replacing_category = c; + init_replacing_replacement_item = il } }); < > + +let init_data_category := + | ALPHABETIC; {InitCategoryAlphabetic} + | ALPHANUMERIC; {InitCategoryAlphanumeric} + | ALPHANUMERIC_EDITED; {InitCategoryAlphanumericEdited} + | BOOLEAN; {InitCategoryBoolean} (* +COB2002 *) + | DATA_POINTER; {InitCategoryDataPointer} (* +COB2002 *) + | FUNCTION_POINTER; {InitCategoryFunctionPointer} + | NATIONAL; {InitCategoryNational} (* +COB2002 *) + | NATIONAL_EDITED; {InitCategoryNationalEdited} (* +COB2002 *) + | NUMERIC; {InitCategoryNumeric} + | NUMERIC_EDITED; {InitCategoryNumericEdited} + | OBJECT_REFERENCE; {InitCategoryObjectReference} (* +COB2002 *) + | PROGRAM_POINTER; {InitCategoryProgramPointer} (* +COB2002 *) + + + +(* INITIATE STATEMENT (+COB85) *) + +%public let unconditional_action := ~ = initiate_statement; < > +let initiate_statement := + | INITIATE; ~ = names; + + + +(* INSPECT STATEMENT *) + +%public let unconditional_action := ~ = inspect_statement; < > +let inspect_statement := + | INSPECT; i = ident; s = inspect_spec; + { Inspect { inspect_item = i; inspect_spec = s } } + +let inspect_spec := + | TALLYING; tpl = rnell(tallying); + { InspectTallying tpl } + | REPLACING; rpl = rnel(loc(replacing_phrase)); + { InspectReplacing rpl } + | TALLYING; tpl = rnell(tallying); + REPLACING; rpl = rnel(loc(replacing_phrase)); + { InspectBoth (tpl, rpl) } + | CONVERTING; + il1 = ident_or_nonnumeric_no_all; TO; il2 = ident_or_nonnumeric; + abl = rl(inspect_where); + { InspectConverting { converting_from = il1; + converting_to = il2; + converting_where = abl; } } + +let tallying := + | i = qualident; FOR; tfl = rnel(loc(tallying_for)); + { { tallying_target = i; tallying_clauses = tfl } } + +let tallying_for := + | CHARACTERS; l = rl(inspect_where); {TallyingCharacters l} + | ALL; l = ident_after_before_list; {TallyingRange (TallyAll, l)} + | LEADING; l = ident_after_before_list; {TallyingRange (TallyLeading, l)} + +let ident_after_before_list := + | iab = ident_after_before; %prec below_RPAR { [iab] } + | iab = ident_after_before; iabl = ident_after_before_list; { iab::iabl } + +let ident_after_before := + | il = ident_or_nonnumeric_no_all; ab = rl(inspect_where); + { { tallying_item = il; tallying_where = ab } } + +let inspect_where := + | AFTER; INITIAL?; i = ident_or_nonnumeric_no_all; {InspectAfter, i} + | BEFORE; INITIAL?; i = ident_or_nonnumeric_no_all; {InspectBefore, i} + +let replacing_phrase := + | CHARACTERS; BY; il = ident_or_nonnumeric_no_all; abo = rl(inspect_where); + { ReplacingCharacters { replacement = il; where = abo } } + | ALL; l = rnel(ident_by_after_before); {ReplacingRange (ReplaceAll, l)} + | LEADING; l = rnel(ident_by_after_before); {ReplacingRange (ReplaceLeading, l)} + | FIRST; l = rnel(ident_by_after_before); {ReplacingRange (ReplaceFirst, l)} + +let ident_by_after_before := + | il1 = ident_or_nonnumeric_no_all; BY; + il2 = ident_or_nonnumeric_no_all; + abo = rl(inspect_where); + { {replacing_item = il1; replacing_by = il2; replacing_where = abo} } + + + +(* INVOKE STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = invoke_statement; < > +let invoke_statement := + | INVOKE; i = ident; is = ident_or_string; + ul = lo(pf(USING,rnel(loc(using_by)))); ro = ro(returning); + { Invoke { invoke_target = i; + invoke_method = is; + invoke_using = ul; + invoke_returning = ro } } + + + +(* MERGE STATEMENT *) + +%public let unconditional_action := ~ = merge_statement; < > +let merge_statement := + | MERGE; i = name; okl = rnel(on_key); cso = ro(collating_sequence_phrase); + USING; il = names; og = output_or_giving; + { Merge { merge_file = i; + merge_keys = okl; + merge_collating = cso; + merge_using = il; + merge_target = og } } + + + +(* MOVE STATEMENT *) + +%public let unconditional_action := ~ = move_statement; < > +let move_statement := + | MOVE; from = ident_or_literal; TO; to_ = idents; + { Move (MoveSimple { from; to_ }) } + | MOVE; CORRESPONDING; from = ident; TO; to_ = idents; + { Move (MoveCorresponding { from; to_ }) } + + + +(* MULTIPLY STATEMENT *) + +%public let unconditional_action := ~ = multiply_statement; +let multiply_statement := + | MULTIPLY; in_ = ident_or_numeric; BY; irl = rounded_idents; + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR);end_multiply; + { { multiply_operands = MultiplyBy { multiplier = in_; multiplicand = irl }; + multiply_on_size_error = h; } } + | MULTIPLY; in1 = ident_or_numeric; BY; in2 = ident_or_numeric; + GIVING; irl = rounded_idents; + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR);end_multiply; + { { multiply_operands = MultiplyGiving { multiplier = in1; + multiplicand = in2; + targets = irl; }; + multiply_on_size_error = h; } } + +let end_multiply := oterm_(END_MULTIPLY) + +(* OPEN STATEMENT (+COB85) *) +(* COB85 has may restrictions over COB2002 as to accepted syntax *) + +%public let unconditional_action := ~ = open_statement; < > +let open_statement := + | OPEN; ~ = rnel(open_phrase); + +let open_phrase := + | om = open_mode; + so = ro(sharing_phrase); (* +COB2002 *) + ro = ro(retry_phrase); (* +COB2002 *) + frl = rnel(file_with_opt); + { { open_mode = om; open_sharing = so; open_retry = ro; open_files = frl} } + +let sharing_phrase [@context sharing_phrase] := + | SHARING; WITH?; ~ = sharing_mode; < > + +let sharing_mode := + | ALL; OTHER?; {SharingAllOther} + | NO; OTHER?; {SharingNoOther} + | READ; ONLY; {SharingReadOnly} + +let file_with_opt := + | i = name; rwo = reversed_or_no_rewind_opt; + { { named_file_name = i; named_file_option = rwo } } + +let reversed_or_no_rewind_opt := + | {None} + | REVERSED; {Some FileOptReversed} (* -COB2002 *) + | mr(NO; REWIND | WITH; NO; REWIND); {Some FileOptWithNoRewind} + + + +(* PERFORM STATEMENT *) +(* COB85 and COB2002 differ significantly *) +(* TODO: COB85 first format also takes instructions... *) + +%public let unconditional_action := ~ = perform_statement; < > +let perform_statement := + | PERFORM; i = qualified_procedure_name; + io = ro(pf(THROUGH,qualified_procedure_name)); + po = io(perform_phrase); + { Perform { perform_target = PerformOutOfLine { procedure_start = i; + procedure_end = io }; + perform_mode = po } } + | PERFORM; po = ro(perform_phrase); isl = imp_stmts; END_PERFORM; + { Perform { perform_target = PerformInline isl; + perform_mode = po } } + +let perform_phrase := + | ~ = ident_or_integer; TIMES; + | wt = ro(with_test); UNTIL; until = condition; + { PerformUntil { with_test = wt; until } } + | wt = ro(with_test); VARYING; v = loc(varying_phrase); + vl = l(pf(AFTER,loc(varying_phrase))); + { PerformVarying { with_test = wt; varying = v; after = vl } } + +let with_test := WITH?; TEST; ~ = after_or_before; < > + +let varying_phrase := + | i = ident; FROM; in_ = ident_or_numeric; + ino = ro(pf(BY,ident_or_numeric)); + UNTIL; c = condition; + { { varying_ident = i; varying_from = in_; + varying_by = ino; varying_until = c } } + + + +(* PURGE STATEMENT (+COB85, -COB2002) *) + +%public let unconditional_action := ~ = purge_statement; < > +let purge_statement := + | PURGE; ~ = name; + + + +(* RAISE STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = raise_statement; +let raise_statement := + | RAISE; EXCEPTION; i = name; { RaiseException i } + | RAISE; i = ident; { RaiseIdent i } + + + +(* READ STATEMENT *) +(* Very ambiguous: sequential and random cases merged and disambiguated later *) +(* Also, COB2002 has more options. *) + +%public let unconditional_action := ~ = read_statement; < > +let read_statement [@context read_stmt] := + | READ; i = name; npo = ro(read_direction); RECORD?; + io = ro(pf(INTO,ident)); + lro = ro(lock_or_retry); (* +COB2002 *) + wlo = with_lock; (* +COB2002 *) + ko = ro(pf(KEY; IS?, qualname)); + ho = io(at_end_or_invalid_key_handler); + oterm_(END_READ); + { Read { read_file = i; + read_direction = npo; + read_into = io; + read_lock_behavior = lro; + read_lock = wlo; + read_key = ko; + read_error_handler = ho } } + +let read_direction := NEXT; {ReadNext} | PREVIOUS; {ReadPrevious} (* +COB2002 *) + +let lock_or_retry := + | ADVANCING; ON?; LOCK; {ReadAdvancingOnLock} + | IGNORING; LOCK; {ReadIgnoringLock} + | ~ = retry_phrase; + + + +(* RECEIVE STATEMENT (+COB85, -COB2002) *) + +%public let unconditional_action := ~ = receive_statement; < > +let receive_statement := + | RECEIVE; i1 = name; ms = message_or_segment; INTO; i2 = ident; + nd = ilo(pf(NO_DATA,imp_stmts)); + wd = ilo(pf(with_data,imp_stmts)); + oterm_(END_RECEIVE); + { Receive { receive_name = i1; receive_kind = ms; receive_into = i2; + receive_on_no_data = { dual_handler_pos = nd; + dual_handler_neg = wd } } } + +let message_or_segment := MESSAGE; {MCSMessage} | SEGMENT; {MCSSegment} +let with_data := DATA | WITH_DATA + + + +(* RELEASE STATEMENT *) + +%public let unconditional_action := ~ = release_statement; < > +let release_statement := + | RELEASE; i = name; ilo = ro(pf(FROM,ident_or_literal)); + { Release { release_item = i; release_from = ilo } } (* Literal only in COB2002+ *) + + + +(* RESUME STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = resume_statement; < > +let resume_statement [@context resume_stmt] := + | RESUME; AT?; NEXT; STATEMENT; { ResumeNextStatement } + | RESUME; AT?; i = qualified_procedure_name; { Resume i } + + + +(* RETURN STATEMENT *) + +%public let unconditional_action := ~ = return_statement; < > +let return_statement := + | RETURN; i = name; RECORD?; io = ro(pf(INTO,loc(ident))); + (* ae = at_end nae = ilo(NOT nae = at_end { nae }) end_return*) + isl1 = pf(at_end,imp_stmts); + isl2 = ilo(pf(NOT_AT_END,imp_stmts)); oterm_(END_RETURN); + { Return { return_file = i; return_into = io; + return_at_end = { dual_handler_pos = isl1; + dual_handler_neg = isl2 } } } + + + +(* REWRITE STATEMENT *) + +%public let unconditional_action := ~ = rewrite_statement; < > +let rewrite_statement := + | REWRITE; if_ = write_target; RECORD?; (* RECORD: +COB2002 *) + ilo = ro(pf(FROM,ident_or_literal)); + ro = ro(retry_phrase); (* +COB2002 *) + wl = with_lock; (* +COB2002 *) + h = handler_opt(INVALID_KEY,NOT_INVALID_KEY); + oterm_(END_REWRITE); + { Rewrite { rewrite_to = if_; + rewrite_from = ilo; + rewrite_retry = ro; + rewrite_lock = wl; + rewrite_invalid_key_handler = h } } + + + +(* SEARCH STATEMENT *) +(* TODO: merge when_clause / statements_or_next *) + +%public let unconditional_action := ~ = search_statement; +let search_statement := + | SEARCH; i = qualname; + io = ro(pf(VARYING,ident)); + ae = ilo(pf(at_end,imp_stmts)); + wcl = nell(loc(when_clause)); + end_search; + { { search_item = i; + search_at_end = ae; + search_spec = SearchSerial { varying = io; when_clauses = wcl } } } + | SEARCH; ALL; i = qualname; + ae = ilo(pf(at_end,imp_stmts)); + WHEN; sc = search_condition; scl = ll(and_clause); + sn = statements_or_next; + end_search; + { { search_item = i; + search_at_end = ae; + search_spec = SearchAll { conditions = sc :: scl; action = sn } } } + +let end_search := oterm_(END_SEARCH) + +let when_clause := + | WHEN; c = condition; s = statements_or_next; + { { search_when_cond = c; search_when_stmts = s } } + +let and_clause := + | AND; ~ = search_condition; < > + +let search_condition := + | i = qualident; IS?; or_(EQUAL, "="); TO?; e = expression; + { IsEqual { data_item = i; condition = e } } + | i = qualident; {Cond i} + +let statements_or_next == + | isl = imp_stmts; {Statements isl} + | NEXT; SENTENCE; {NextSentence} + + + +(* SEND STATEMENT (+COB85, -COB2002) *) +(* Somewhat ambiguous *) + +%public let unconditional_action := ~ = send_statement; < > +let send_statement := + | SEND; i1 = name; FROM; i2 = ident; + { Send { send_name = i1; + send_operands = SendSimple { from = i2 } } } + | SEND; i = name; io = io(pf(FROM,ident)); WITH?; ei = ending_indicator; + ao = ro(advancing_phrase); r = bo(REPLACING; LINE); + { Send { send_name = i; + send_operands = SendWith { from = io; + ending_indicator = ei; + advancing = ao; + replace = r } } } + +let ending_indicator := + | i = ident; {EndingIndicator i} + | ESI; {EndingIndicatorESI} + | EMI; {EndingIndicatorEMI} + | EGI; {EndingIndicatorEGI} + +let advancing_phrase := + | stage = after_or_before; ADVANCING?; PAGE; + { AdvancingPage { stage } } + | stage = after_or_before; ADVANCING?; i = ident_or_integer; + b = bo(or_(LINE,LINES)); + { AdvancingLines { stage; lines = i; ambiguous = not b } } + + + +(* SET STATEMENT *) +(* Very ambiguous *) + +%public let unconditional_action := ~ = set_statement; +let set_statement [@context set_stmt] := + (* Ambiguous cases (formats 1, 2, 5, 7, 8, 9, 10 and 14) *) + | SET; i = ident; TO; la = locale_or_ambiguous; + { match la with + | `Locale ld -> + SetSaveLocale { target = i; locale = ld } + | `Expr e -> + SetAmbiguous { targets = [i]; value = e; + set_method = SetMethodTo } } + | SET; i = ident; il = idents; TO; e = expression; + { SetAmbiguous { targets = i :: il; set_method = SetMethodTo; value = e } } + | SET; il = idents; ud = up_down; e = expression; + { SetAmbiguous { targets = il; set_method = ud; value = e } } + (* Switch and Condition (formats 3 and 4) *) + | SET; sl = rnell(i = ident; TO; oo = on_or_off; + { { set_switch_targets = [i]; set_switch_value = oo } }); + { SetSwitch sl } + | SET; sl = rnell(i = ident; il = idents; TO; oo = on_or_off; + { { set_switch_targets = i :: il; set_switch_value = oo } }); + { SetSwitch sl } + | SET; cl = rnell(i = ident; TO; tf = boollit; + { { set_condition_targets = [i]; set_condition_value = tf } }); + { SetCondition cl } + | SET; cl = rnell(i = ident; il = idents; TO; tf = boollit; + { { set_condition_targets = i :: il; set_condition_value = tf } }); + { SetCondition cl } + + (* The following were added in COB2002 (formats 6, 11, 12, 13, 15) *) + | SET; i = name; al = set_attribute_switches; + { SetAttribute { name = i; attribute_switches = al } } + | SET; LOCALE; ld = locale_or_default; TO; lv = locale_value_or_ident; + { SetLocale { target = ld; source = lv } } + | SET; LAST; EXCEPTION; TO; OFF; + { SetSavedException } + | SET; CONTENT; OF?; il = idents; TO; fc = float_content; so = ro(sign); + { SetFloatContent { targets = il; content = fc; sign = so } } + +let locale_or_ambiguous := + | LOCALE; ld = lc_all_or_default; { `Locale ld } + | e = expression; { `Expr e } + +let set_attribute_switches [@context set_attribute_stmt] := + | ATTRIBUTE; ~ = rnel(screen_attribute_on_off); < > + +let screen_attribute_on_off := + | sa = screen_attribute_name; oo = on_or_off; + { { set_attribute = sa; set_attribute_switch_value = oo} } + +let up_down := + | UP; BY; {SetMethodUp} + | DOWN; BY; {SetMethodDown} + +let on_or_off := + | ON; {On} + | OFF; {Off} + +let boollit := + | TRUE; {true} + | FALSE; {false} + +let screen_attribute_name := + | BELL; {ScreenBell} + | BLINK; {ScreenBlink} + | HIGHLIGHT; {ScreenHighlight} + | LOWLIGHT; {ScreenLowlight} + | REVERSE_VIDEO; {ScreenReverseVideo} + | UNDERLINE; {ScreenUnderline} + +let locale_category := + | LC_ALL; {LcAll} + | LC_COLLATE; {LcCollate} + | LC_CTYPE; {LcCtype} + | LC_MESSAGES; {LcMessages} + | LC_MONETARY; {LcMonetary} + | LC_NUMERIC; {LcNumeric} + | LC_TIME; {LcTime} + +let locale_or_default := + | l = locale_category; {SetLocaleTarget l} + | USER_DEFAULT; {SetLocaleTargetUserDefault} + +let locale_value_or_ident := + | i = ident; {SetLocaleSource i} + | USER_DEFAULT; {SetLocaleSourceUserDefault} + | SYSTEM_DEFAULT; {SetLocaleSourceSystemDefault} + +let lc_all_or_default := + | LC_ALL; {SetSaveLocaleLcAll} + | USER_DEFAULT; {SetSaveLocaleUserDefault} + +let float_content := + | FARTHEST_FROM_ZERO; ~ = bo(IN_ARITHMETIC_RANGE); + | NEAREST_TO_ZERO; ~ = bo(IN_ARITHMETIC_RANGE); + | FLOAT_INFINITY; {FloatInfinity} + | FLOAT_NOT_A_NUMBER; {FloatNotANumber} + | FLOAT_NOT_A_NUMBER_SIGNALING; {FloatNotANumberSignaling} + +let sign := + | POSITIVE; {SgnPositive} + | NEGATIVE; {SgnNegative} + + + +(* SORT STATEMENT *) + +%public let unconditional_action := ~ = sort_statement; < > +let sort_statement := + | SORT; i = qualident; + wd = ibo(WITH?; DUPLICATES; IN?; ORDER?); + cso = ro(collating_sequence_phrase); + { Sort (SortTable { table = i; + keys = []; + duplicate_in_order = wd; + collating = cso }) } + | SORT; i = qualident; okl = rnel(on_key); + wd = ibo(WITH?; DUPLICATES; IN?; ORDER?); + cso = ro(collating_sequence_phrase); + { Sort (SortTable { table = i; + keys = okl; + duplicate_in_order = wd; + collating = cso }) } + | SORT; i = qualident; okl = rnel(on_key); + wd = ibo(WITH?; DUPLICATES; IN?; ORDER?); + cso = ro(collating_sequence_phrase); + iu = input_or_using; + og = output_or_giving; + { Sort (SortFile { file = i; + keys = okl; + duplicate_in_order = wd; + collating = cso; + source = iu; + target = og }) } +(* COB2002 also has an alternate more restricted form for tables *) + +let input_or_using := + | INPUT; PROCEDURE; IS?; i = procedure_name; + io = ro(pf(THROUGH,procedure_name)); + { SortInputProcedure { procedure_start = i; procedure_end = io } } + | USING; names = names; + { SortUsing names } + + + +(* START STATEMENT *) + +%public let unconditional_action := ~ = start_statement; < > +let start_statement := + | START; i = name; fpo = io(start_position); + h = handler_opt(INVALID_KEY,NOT_INVALID_KEY); oterm_(END_START); + { Start { start_file = i; start_position = fpo; start_on_invalid_key = h} } + +let start_position == + | FIRST; { StartPositionFirst } + | LAST; { StartPositionLast } + | KEY; ro = relop; i = qualname; + wlo = io(pf(WITH?; LENGTH,expression)); (* arith *) + { StartPositionKey { operator = ro; name = i; length = wlo } } + + + +(* STOP STATEMENT *) + +%public let unconditional_action := ~ = stop_statement; +let stop_statement [@context stop_stmt] := + | STOP; RUN; so = ro(with_status); { StopRun so } (* status: +COB2002 *) + | STOP; l = literal; { StopLiteral l } (* ~COB85, -COB2002 *) + +let with_status := + | WITH; stop_kind = stop_kind; + STATUS?; stop_status = ident_or_literal; { { stop_kind; stop_status } } + +let stop_kind := + | ERROR; {StopRunError} + | NORMAL; {StopRunNormal} + + + +(* STRING STATEMENT *) + +%public let unconditional_action := ~ = string_statement; < > +let string_statement := + | STRING; ss = nell(source_string); INTO; i = ident; + wp = io(pf(WITH?; POINTER,ident)); + h = handler_opt(on_overflow,NOT_ON_OVERFLOW); oterm_(END_STRING); + { String { string_sources = ss; string_target = i; + string_pointer = wp; string_on_overflow = h } } + +let source_string := + | i = ident_or_nonnumeric_no_all; db = ro(s_delimited_by); + { { string_source = i; string_delimiter = db} } + +(* NOTE: This is not perfectly standard, but we can figure out the delimiter for each item + * in later analysis *) +let s_delimited_by := + | DELIMITED; BY?; ~ = ident_or_nonnumeric_no_all; + | DELIMITED; BY?; SIZE; {StringDelimiterSize} + + + +(* SUBTRACT STATEMENT *) + +%public let unconditional_action := ~ = subtract_statement; < > +let subtract_statement := + | SUBTRACT; inl = idents_or_numerics; FROM; irl = rounded_idents; + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); end_subtract; + { Subtract { basic_arith_operands = + ArithSimple { sources = inl; targets = irl }; + basic_arith_on_size_error = h } } + | SUBTRACT; inl = idents_or_numerics; FROM; in_ = ident_or_numeric; + GIVING; irl = rounded_idents; + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); end_subtract; + { Subtract { basic_arith_operands = + ArithGiving { sources = inl; + to_or_from_item = in_; + targets = irl }; + basic_arith_on_size_error = h } } + | SUBTRACT; CORRESPONDING; i = qualname; FROM; ir = rounded_ident; + h = handler_opt(ON_SIZE_ERROR,NOT_ON_SIZE_ERROR); end_subtract; + { Subtract { basic_arith_operands = + ArithCorresponding { source = i; target = ir }; + basic_arith_on_size_error = h } } +(* COB85: 1 ON SIZE ERROR, THEN 1 NOT ON SIZE ERROR + COB2002: order irrelevant *) + +let end_subtract := oterm_(END_SUBTRACT) + + + +(* SUPPRESS STATEMENT (+COB85) *) +(* May only be used in USE BEFORE REPORTING *) + +%public let unconditional_action := ~ = suppress_statement; < > +let suppress_statement := + | SUPPRESS; PRINTING?; {Suppress} + + + +(* TERMINATE STATEMENT (+COB85) *) + +%public let unconditional_action := ~ = terminate_statement; < > +let terminate_statement := + | TERMINATE; ~ = names; + + + +(* TRANSFORM STATEMENT (GCOS7, MF (via IBM OS/VS), maybe others, and obviously + GnuCOBOL) --- TODO: dialect option? *) + +%public let unconditional_action := ~ = transform_statement; < > +let transform_statement := + | TRANSFORM; i = loc(ident); CHARACTERS?; + FROM; from = loc(ident_or_nonnumeric_no_all); (* CHECKME: ALL? *) + TO; to_ = loc(ident_or_nonnumeric); (* ditto *) + { Transform { transform_ident = i; + transform_from = from; + transform_to = to_ } } + + + +(* UNLOCK STATEMENT (+COB2014 ?) *) + +%public let unconditional_action := ~ = unlock_statement; < > +let unlock_statement := + | UNLOCK; i = name; ro = bo(or_(RECORD,RECORDS)); + { Unlock { unlock_file = i; unlock_record = ro } } + + + +(* UNSTRING STATEMENT *) + +%public let unconditional_action := ~ = unstring_statement; < > +let unstring_statement := + | UNSTRING; i = ident; dbo = unstring_delimiters; + INTO; idl = rnel(unstring_target); + wp = io(pf(WITH?; POINTER,ident)); + ti = io(pf(TALLYING; IN?,ident)); + h = handler_opt(on_overflow,NOT_ON_OVERFLOW); oterm_(END_UNSTRING); + { Unstring { unstring_source = i; + unstring_delimiters = dbo; + unstring_targets = idl; + unstring_pointer = wp; + unstring_tallying = ti; + unstring_on_overflow = h } } + +let unstring_delimiters [@recovery []] [@symbol ""] := + | (* empty *) { [] } + | DELIMITED; BY?; ao = bo(ALL); il = ident_or_string_no_all; + aill = l(OR; ao = bo(ALL); il = ident_or_string_no_all; + { { unstring_delimiter_by_all = ao; unstring_delimiter = il } }); + { { unstring_delimiter_by_all = ao; unstring_delimiter = il } :: aill } + +let unstring_target := + | i = ident; i1o = ro(pf(DELIMITER; IN?,ident)); + i2o = ro(pf(COUNT; IN?,ident)); + { { unstring_target = i; + unstring_target_delimiter = i1o; + unstring_target_count = i2o } } + + + +(* USE STATEMENT *) + +(* +SEQUENTIAL/RELATIVE/INDEXED IO (when USE is present) (P 408, 446, 488) + USE AFTER STANDARD {EXCEPTION/ERROR} PROCEDURE ON {fname/IN/OUT/EXT}... +IPC (P 550) + USE GLOBAL? AFTER STANDARD {EXCEPTION/ERROR} PROCEDURE ON {fn/IN/OUT/EXT}... + USE GLOBAL? BEFORE REPORTING ident +REPORT WRITER (P 640) + USE AFTER STANDARD {EXCEPTION/ERROR} PROCEDURE ON {fn/OUT/EXT}... + USE BEFORE REPORTING ident +DEBUGGING (P 692) + USE FOR DEBUGGING ON {cn/fn/pn/[ALL REFS OF]id/ALL PROCS}... +*) + +let use_statement := + | USE; g = ibo(GLOBAL); io(AFTER); io(STANDARD); + or_(EXCEPTION, ERROR); PROCEDURE?; ON?; io = names_or_open_mode; + { UseAfterFileException { global = g; trigger = io } } + | USE; g = bo(GLOBAL); BEFORE; REPORTING; i = ident; + { UseBeforeReporting { global = g; report_group = i } } + | USE; FOR?; DEBUGGING; ON?; dt = rnel(debug_target); (* -COB2002 *) + { UseForDebugging dt } + | USE; io(AFTER); exception_condition; + efl = rnel(use_after_exception); (* +COB2002 *) + { UseAfterIOException efl } + | USE; io(AFTER); exception_object; i = name; (* +COB2002 *) + { UseAfterExceptionObject i } + +let names_or_open_mode := + | i = names; { UseFileExceptionOnNames i } + | om = open_mode; { UseFileExceptionOnOpenMode om } + +let exception_condition == EXCEPTION; CONDITION | EC +let exception_object == EXCEPTION; OBJECT | EO + +let use_after_exception := + | i = name; fl = rl(pf(FILE,name)); + { { use_after_exception = i; use_after_exception_on_files = fl } } + +let debug_target := + | all = bo(ALL; REFERENCES?; OF?); procedure = qualified_procedure_name; + { UseForDebuggingProcedure { all; procedure } } + | ALL; PROCEDURES; + { UseForDebuggingAllProcedures } + + + +(* VALIDATE STATEMENT (+COB2002) *) + +%public let unconditional_action := ~ = validate_statement; < > +let validate_statement := + | VALIDATE; ~ = idents; + + + +(* WRITE STATEMENT *) +(* Sequential and random cases are ambiguous -> merged *) +%public let unconditional_action := ~ = write_statement; < > +write_statement: + | WRITE if_ = write_target + fo = ro(pf(FROM,ident_or_literal)) + ao = ro(advancing_phrase) + ro = ro(retry_phrase) + wl = with_lock + ho = io(end_of_page_or_invalid_key_handler) + oterm_(END_WRITE) + { Write { write_to = if_; + write_from = fo; + write_advancing = ao; + write_retry = ro; + write_lock = wl; + write_error_handler = ho } } + +let write_target := + | n = qualname; {WriteTargetName n} + | FILE; n = name; {WriteTargetFile n} + +(* --- Standalone (for testing) --------------------------------------------- *) + +standalone_condition: condition EOF { $1 }; + +(* -------------------------------------------------------------------------- *) + +%% diff --git a/src/lsp/cobol_parser/grammar_common.mly b/src/lsp/cobol_parser/grammar_common.mly new file mode 120000 index 000000000..7e730907d --- /dev/null +++ b/src/lsp/cobol_parser/grammar_common.mly @@ -0,0 +1 @@ +../cobol_preproc/grammar_common.mly \ No newline at end of file diff --git a/src/lsp/cobol_parser/grammar_context.ml b/src/lsp/cobol_parser/grammar_context.ml new file mode 100644 index 000000000..02c909739 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_context.ml @@ -0,0 +1,137 @@ +(* Caution: this file was automatically generated from grammar.cmly; do not edit *) +open Grammar +open MenhirInterpreter +open Grammar_contexts + +let nonterminal_context: type k. k nonterminal -> _ option = function + | N_validate_status_clause -> Some validate_status_clause + | N_usage -> Some usage_clause (* ok as none of leftmost terminals are C/S *) + | N_typedef_clause -> Some typedef_clause + | N_stop_statement -> Some stop_stmt + | N_sharing_phrase -> Some sharing_phrase + | N_sharing_clause -> Some sharing_clause + | N_set_statement -> Some set_stmt + | N_set_attribute_switches -> Some set_attribute_stmt + | N_screen_descr_entry -> Some screen_descr_entry + | N_rounded_phrase -> Some rounded_phrase + | N_rounded_clause -> Some rounded_phrase + | N_retry_phrase -> Some retry_phrase + | N_resume_statement -> Some resume_stmt + | N_report_occurs_clause -> Some occurs_clause + | N_read_statement -> Some read_stmt + | N_program_id_paragraph -> Some program_id_paragraph + | N_options_paragraph -> Some options_paragraph + | N_occurs_fixed_clause -> Some occurs_clause + | N_occurs_dynamic_clause -> Some occurs_clause + | N_occurs_depending_clause -> Some occurs_clause + | N_object_paragraph -> Some object_paragraph + | N_object_computer_paragraph -> Some object_computer_paragraph + | N_lock_mode_clause -> Some lock_mode_clause + | N_line_header -> Some line_clause (*NUMBERS only*) + | N_intermediate_rounding_clause -> Some intermediate_rounding_clause + | N_interface_specifier -> Some interface_specifier + | N_function_specifier -> Some function_specifier + | N_float_decimal_clause -> Some float_decimal_clause + | N_float_binary_clause -> Some float_binary_clause + | N_factory_paragraph -> Some factory_paragraph + | N_exit_statement -> Some exit_stmt + | N_erase_clause -> Some erase_clause + | N_entry_convention_clause -> Some entry_convention_clause + | N_dynamic_length_structure_clause -> Some dynlen_struct_clause + | N_default_clause -> Some default_clause + | N_currency_sign_clause -> Some currency_clause + | N_constant_value_length -> Some constant + | N_column_header -> Some column_clause (* NUMBERS & CENTER *) + | N_class_specifier -> Some class_specifier + | N_arithmetic_clause -> Some arithmetic_clause + | N_alphabet_name_clause -> Some alphabet_clause + | N_allocate_statement -> Some allocate_stmt + | N_accept_statement -> Some accept_stmt + | _ -> None + +let contexts_for_state_num: int -> _ list = function + | 114 -> [options_paragraph] + | 116 -> [intermediate_rounding_clause] + | 128 -> [float_decimal_clause] + | 141 -> [float_binary_clause] + | 145 -> [entry_convention_clause] + | 148 -> [rounded_phrase] + | 154 -> [arithmetic_clause] + | 193 -> [object_computer_paragraph] + | 308 -> [dynlen_struct_clause] + | 328 -> [currency_clause] + | 366 -> [alphabet_clause] + | 442 -> [interface_specifier] + | 452 -> [function_specifier] + | 459 -> [class_specifier] + | 488 -> [sharing_clause] + | 540 -> [lock_mode_clause] + | 1061 -> [validate_status_clause] + | 1087 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1092 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1094 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1095 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1108 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1109 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1110 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1113 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1114 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1115 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1116 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1119 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1121 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1126 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1128 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1130 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1131 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1132 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1133 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1134 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1135 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1136 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1137 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1138 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1139 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1140 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1141 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1142 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1143 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1144 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1145 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1151 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1153 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1155 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1157 -> [usage_clause (* ok as none of leftmost terminals are C/S *)] + | 1159 -> [typedef_clause] + | 1359 -> [occurs_clause] + | 1413 -> [typedef_clause] + | 1439 -> [default_clause] + | 1447 -> [constant] + | 1915 -> [occurs_clause] + | 1942 -> [line_clause (*NUMBERS only*)] + | 1944 -> [line_clause (*NUMBERS only*)] + | 1955 -> [column_clause (* NUMBERS & CENTER *)] + | 1961 -> [column_clause (* NUMBERS & CENTER *)] + | 1966 -> [column_clause (* NUMBERS & CENTER *)] + | 1988 -> [rounded_phrase] + | 2057 -> [screen_descr_entry] + | 2098 -> [erase_clause] + | 2355 -> [retry_phrase] + | 2449 -> [stop_stmt] + | 2518 -> [set_stmt] + | 2578 -> [set_attribute_stmt] + | 2666 -> [resume_stmt] + | 2684 -> [read_stmt] + | 2743 -> [sharing_phrase] + | 2985 -> [exit_stmt] + | 3122 -> [allocate_stmt] + | 3136 -> [accept_stmt] + | 3856 -> [object_paragraph] + | 3862 -> [factory_paragraph] + | 3900 -> [program_id_paragraph] + | 3973 -> [program_id_paragraph] + | _ -> [] + +let contexts: type k. k lr1state -> _ list = fun s -> + contexts_for_state_num (number s) + diff --git a/src/lsp/cobol_parser/grammar_contexts.ml b/src/lsp/cobol_parser/grammar_contexts.ml new file mode 100644 index 000000000..8037d6a67 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_contexts.ml @@ -0,0 +1,625 @@ +(* Caution this file was automatically generated from grammar.cmly; do not edit *) +module TH = Text_lexer.TokenHandles +type context = TH.t + +type t = context +type contexts = + { + accept_stmt: t; + allocate_stmt: t; + alphabet_clause: t; + arithmetic_clause: t; + class_specifier: t; + column_clause: t; + constant: t; + currency_clause: t; + default_clause: t; + dynlen_struct_clause: t; + entry_convention_clause: t; + erase_clause: t; + exit_stmt: t; + factory_paragraph: t; + float_binary_clause: t; + float_decimal_clause: t; + function_specifier: t; + interface_specifier: t; + intermediate_rounding_clause: t; + line_clause: t; + lock_mode_clause: t; + object_computer_paragraph: t; + object_paragraph: t; + occurs_clause: t; + options_paragrahp: t; + options_paragraph: t; + options_pragraph: t; + program_id_paragraph: t; + read_statement: t; + read_stmt: t; + resume_stmt: t; + retry_phrase: t; + rounded_phrase: t; + screen_descr_entry: t; + screnn_descr_entry: t; + set_attribute_stmt: t; + set_stmt: t; + sharing_clause: t; + sharing_phrase: t; + stop_stmt: t; + typedef_clause: t; + usage_clause: t; + validate_status_clause: t; + } + +let all, sensitive_tokens, sensitive_tokens_unimplemented = + let open TH in + let empty = + { + accept_stmt = empty; + allocate_stmt = empty; + alphabet_clause = empty; + arithmetic_clause = empty; + class_specifier = empty; + column_clause = empty; + constant = empty; + currency_clause = empty; + default_clause = empty; + dynlen_struct_clause = empty; + entry_convention_clause = empty; + erase_clause = empty; + exit_stmt = empty; + factory_paragraph = empty; + float_binary_clause = empty; + float_decimal_clause = empty; + function_specifier = empty; + interface_specifier = empty; + intermediate_rounding_clause = empty; + line_clause = empty; + lock_mode_clause = empty; + object_computer_paragraph = empty; + object_paragraph = empty; + occurs_clause = empty; + options_paragrahp = empty; + options_paragraph = empty; + options_pragraph = empty; + program_id_paragraph = empty; + read_statement = empty; + read_stmt = empty; + resume_stmt = empty; + retry_phrase = empty; + rounded_phrase = empty; + screen_descr_entry = empty; + screnn_descr_entry = empty; + set_attribute_stmt = empty; + set_stmt = empty; + sharing_clause = empty; + sharing_phrase = empty; + stop_stmt = empty; + typedef_clause = empty; + usage_clause = empty; + validate_status_clause = empty; + } + in + let accept_stmt t c = { c with accept_stmt = add t c.accept_stmt } in + let allocate_stmt t c = { c with allocate_stmt = add t c.allocate_stmt } in + let alphabet_clause t c = { c with alphabet_clause = add t c.alphabet_clause } in + let arithmetic_clause t c = { c with arithmetic_clause = add t c.arithmetic_clause } in + let class_specifier t c = { c with class_specifier = add t c.class_specifier } in + let column_clause t c = { c with column_clause = add t c.column_clause } in + let constant t c = { c with constant = add t c.constant } in + let currency_clause t c = { c with currency_clause = add t c.currency_clause } in + let default_clause t c = { c with default_clause = add t c.default_clause } in + let dynlen_struct_clause t c = { c with dynlen_struct_clause = add t c.dynlen_struct_clause } in + let entry_convention_clause t c = { c with entry_convention_clause = add t c.entry_convention_clause } in + let erase_clause t c = { c with erase_clause = add t c.erase_clause } in + let exit_stmt t c = { c with exit_stmt = add t c.exit_stmt } in + let factory_paragraph t c = { c with factory_paragraph = add t c.factory_paragraph } in + let float_binary_clause t c = { c with float_binary_clause = add t c.float_binary_clause } in + let float_decimal_clause t c = { c with float_decimal_clause = add t c.float_decimal_clause } in + let function_specifier t c = { c with function_specifier = add t c.function_specifier } in + let interface_specifier t c = { c with interface_specifier = add t c.interface_specifier } in + let intermediate_rounding_clause t c = { c with intermediate_rounding_clause = add t c.intermediate_rounding_clause } in + let line_clause t c = { c with line_clause = add t c.line_clause } in + let lock_mode_clause t c = { c with lock_mode_clause = add t c.lock_mode_clause } in + let object_computer_paragraph t c = { c with object_computer_paragraph = add t c.object_computer_paragraph } in + let object_paragraph t c = { c with object_paragraph = add t c.object_paragraph } in + let occurs_clause t c = { c with occurs_clause = add t c.occurs_clause } in + let options_paragrahp t c = { c with options_paragrahp = add t c.options_paragrahp } in + let options_paragraph t c = { c with options_paragraph = add t c.options_paragraph } in + let options_pragraph t c = { c with options_pragraph = add t c.options_pragraph } in + let program_id_paragraph t c = { c with program_id_paragraph = add t c.program_id_paragraph } in + let read_statement t c = { c with read_statement = add t c.read_statement } in + let read_stmt t c = { c with read_stmt = add t c.read_stmt } in + let resume_stmt t c = { c with resume_stmt = add t c.resume_stmt } in + let retry_phrase t c = { c with retry_phrase = add t c.retry_phrase } in + let rounded_phrase t c = { c with rounded_phrase = add t c.rounded_phrase } in + let screen_descr_entry t c = { c with screen_descr_entry = add t c.screen_descr_entry } in + let screnn_descr_entry t c = { c with screnn_descr_entry = add t c.screnn_descr_entry } in + let set_attribute_stmt t c = { c with set_attribute_stmt = add t c.set_attribute_stmt } in + let set_stmt t c = { c with set_stmt = add t c.set_stmt } in + let sharing_clause t c = { c with sharing_clause = add t c.sharing_clause } in + let sharing_phrase t c = { c with sharing_phrase = add t c.sharing_phrase } in + let stop_stmt t c = { c with stop_stmt = add t c.stop_stmt } in + let typedef_clause t c = { c with typedef_clause = add t c.typedef_clause } in + let usage_clause t c = { c with usage_clause = add t c.usage_clause } in + let validate_status_clause t c = { c with validate_status_clause = add t c.validate_status_clause } in + let specs = Grammar_tokens.[ + ACTION, []; + ACTIVATING, []; + ACTIVE_X, []; + ACTUAL, []; + ADJUSTABLE_COLUMNS, []; + ALIGNMENT, []; + ALLOWING, []; + ANUM, []; + APPLY, []; + ARITHMETIC, [options_paragraph]; + ASCII, []; + ATTRIBUTE, [set_stmt]; + ATTRIBUTES, []; + AUTO, [screen_descr_entry]; + AUTOMATIC, [lock_mode_clause]; + AUTO_DECIMAL, []; + AUTO_SPIN, []; + AWAY_FROM_ZERO, [rounded_phrase]; + BACKGROUND_COLOR, [screen_descr_entry]; + BACKWARD, []; + BAR, []; + BELL, [screen_descr_entry; set_attribute_stmt]; + BINARY_ENCODING, [usage_clause; set_attribute_stmt]; + BITMAP, []; + BITMAP_END, []; + BITMAP_HANDLE, []; + BITMAP_NUMBER, []; + BITMAP_START, []; + BITMAP_TIMER, []; + BITMAP_TRAILING, []; + BITMAP_TRANSPARENT_COLOR, []; + BITMAP_WIDTH, []; + BLINK, [screen_descr_entry; set_attribute_stmt]; + BOX, []; + BOXED, []; + BULK_ADDITION, []; + BUSY, []; + BUTTONS, []; + BYTE, []; + BYTE_LENGTH, [constant]; + C, []; + CALENDAR_FONT, []; + CANCEL_BUTTON, []; + CAPACITY, [occurs_clause]; + CARD_PUNCH, []; + CARD_READER, []; + CASSETTE, []; + CCOL, []; + CELL, []; + CELL_COLOR, []; + CELL_DATA, []; + CELL_FONT, []; + CELL_PROTECTION, []; + CENTER, [column_clause]; + CENTERED, []; + CENTERED_HEADINGS, []; + CENTURY_DATE, []; + CHANGED, []; + CHECK_BOX, []; + CLASSIFICATION, [object_computer_paragraph]; + CLEAR_SELECTION, []; + CLINE, []; + CLINES, []; + COBOL, [entry_convention_clause]; + COLORS, []; + COLUMN_COLOR, []; + COLUMN_DIVIDERS, []; + COLUMN_FONT, []; + COLUMN_HEADINGS, []; + COLUMN_PROTECTION, []; + COMBO_BOX, []; + CONVERSION, []; + COPY_SELECTION, []; + CORE_INDEX, []; + CSIZE, []; + CURRENT, []; + CURSOR_COL, []; + CURSOR_COLOR, []; + CURSOR_FRAME_WIDTH, []; + CURSOR_ROW, []; + CURSOR_X, []; + CURSOR_Y, []; + CUSTOM_PRINT_TEMPLATE, []; + CYCLE, []; + CYL_INDEX, []; + CYL_OVERFLOW, []; + DASHED, []; + DATA_COLUMNS, []; + DATA_TYPES, []; + DATE_ENTRY, []; + DECIMAL_ENCODING, [usage_clause; float_decimal_clause]; + DEFAULT_BUTTON, []; + DISC, []; + DISK, []; + DISP, []; + DISPLAY_COLUMNS, []; + DISPLAY_FORMAT, []; + DIVIDERS, []; + DIVIDER_COLOR, []; + DOTDASH, []; + DOTTED, []; + DRAG_COLOR, []; + DROP_DOWN, []; + DROP_LIST, []; + EBCDIC, []; + ELEMENT, []; + ENCODING, []; + ENCRYPTION, []; + END_COLOR, []; + END_MODIFY, []; + ENGRAVED, []; + ENSURE_VISIBLE, []; + ENTRY_CONVENTION, [options_paragraph]; + ENTRY_FIELD, []; + ENTRY_REASON, []; + EOL, [erase_clause]; + EOS, [erase_clause]; + ERASE, [screen_descr_entry]; + ESCAPE_BUTTON, []; + EVENT_LIST, []; + EVERY, []; + EXCEPTION_VALUE, []; + EXPAND, []; + EXPANDS, [class_specifier; interface_specifier]; + EXTENDED_SEARCH, []; + EXTERN, []; + F, []; + FH__FCD, []; + FH__KEYDEF, []; + FILE_LIMIT, []; + FILE_LIMITS, []; + FILE_NAME, []; + FILE_POS, []; + FILL_COLOR, []; + FILL_COLOR2, []; + FILL_PERCENT, []; + FINISH_REASON, []; + FIXED_WIDTH, []; + FLAT, []; + FLAT_BUTTONS, []; + FLOAT_BINARY, [options_paragraph]; + FLOAT_DECIMAL, [options_paragrahp]; + FLOAT_NOT_A_NUMBER, []; + FOREGROUND_COLOR, [screen_descr_entry]; + FOREVER, [retry_phrase]; + FRAME, []; + FRAMED, []; + FULL, [screnn_descr_entry]; + FULL_HEIGHT, []; + GO_BACK, []; + GO_FORWARD, []; + GO_HOME, []; + GO_SEARCH, []; + GRAPHICAL, []; + GRID, []; + GROUP_VALUE, []; + HAS_CHILDREN, []; + HEADING_COLOR, []; + HEADING_DIVIDER_COLOR, []; + HEADING_FONT, []; + HEAVY, []; + HEIGHT_IN_CELLS, []; + HEX, []; + HIGHLIGHT, [screen_descr_entry]; + HIGH_COLOR, []; + HIGH_ORDER_LEFT, [float_binary_clause; + float_decimal_clause]; + HIGH_ORDER_RIGHT, [float_binary_clause; float_decimal_clause]; + HOT_TRACK, []; + HSCROLL, []; + HSCROLL_POS, []; + ICON, []; + IGNORING, [read_statement]; + IMPLEMENTS, [factory_paragraph; object_paragraph]; + INDEPENDENT, []; + INITIALIZED, [allocate_stmt; occurs_clause]; + INSERTION_INDEX, []; + INSERT_ROWS, []; + INTERMEDIATE, [options_pragraph]; + INTRINSIC, [function_specifier]; + ITEM, []; + ITEM_TEXT, []; + ITEM_TO_ADD, []; + ITEM_TO_DELETE, []; + ITEM_TO_EMPTY, []; + ITEM_VALUE, []; + KEYBOARD, []; + LABEL_OFFSET, []; + LARGE_OFFSET, []; + LAST_ROW, []; + LAYOUT_DATA, []; + LC_ALL, [set_stmt]; + LC_COLLATE, [set_stmt]; + LC_CTYPE, [set_stmt]; + LC_MESSAGES, [set_stmt]; + LC_MONETARY, [set_stmt]; + LC_NUMERIC, [set_stmt]; + LC_TIME, [set_stmt]; + LEADING_SHIFT, []; + LEAVE, []; + LEFT_TEXT, []; + LINES_AT_ROOT, []; + LINE_SEQUENTIAL, []; + LIST_BOX, []; + LOC, []; + LOCATION, []; + LOCK_HOLDING, []; + LONG_DATE, []; + LOWER, []; + LOWERED, []; + LOWLIGHT, [screen_descr_entry; set_attribute_stmt]; + LOW_COLOR, []; + MAGNETIC_TAPE, []; + MANUAL, [lock_mode_clause]; + MASS_UPDATE, []; + MASTER_INDEX, []; + MAX_LINES, []; + MAX_PROGRESS, []; + MAX_TEXT, []; + MAX_VAL, []; + MEMORY, []; + MICROSECOND_TIME, []; + MIN_VAL, []; + MODULES, []; + MULTILINE, []; + NAME, []; + NAMED, []; + NAMESPACE, []; + NAMESPACE_PREFIX, []; + NAT, []; + NAVIGATE_URL, []; + NEAREST_AWAY_FROM_ZERO, [intermediate_rounding_clause; + rounded_phrase]; + NEAREST_EVEN, [intermediate_rounding_clause; + rounded_phrase]; + NEAREST_TOWARD_ZERO, [intermediate_rounding_clause; + rounded_phrase]; + NEXT_ITEM, []; + NOMINAL, []; + NONE, [default_clause]; + NONNUMERIC, []; + NORMAL, [stop_stmt]; + NOTAB, []; + NOTIFY, []; + NOTIFY_CHANGE, []; + NOTIFY_DBLCLICK, []; + NOTIFY_SELCHANGE, []; + NO_AUTOSEL, []; + NO_AUTO_DEFAULT, []; + NO_BOX, []; + NO_DIVIDERS, []; + NO_F4, []; + NO_FOCUS, []; + NO_GROUP_TAB, []; + NO_KEY_LETTER, []; + NO_SEARCH, []; + NO_UPDOWN, []; + NUMBERS, [column_clause; line_clause]; + NUM_COL_HEADINGS, []; + NUM_ROWS, []; + OK_BUTTON, []; + ONLY, [sharing_clause; sharing_phrase; usage_clause]; + OTHERS, []; + OVERLAP_LEFT, []; + OVERLAP_TOP, []; + PAGE, []; + PAGE_SETUP, []; + PARAGRAPH, [exit_stmt]; + PARENT, []; + PARSE, []; + PASCAL, []; + PASSWORD, []; + PERMANENT, []; + PIXEL, []; + PLACEMENT, []; + POP_UP, []; + POS, []; + POSITION_SHIFT, []; + PREFIXED, [dynlen_struct_clause]; + PREVIOUS, [read_stmt]; + PRINT, []; + PRINTER, []; + PRINTER_1, []; + PRINT_NO_PROMPT, []; + PRINT_PREVIEW, []; + PROCESSING, []; + PROGRESS, []; + PROHIBITED, [intermediate_rounding_clause; rounded_phrase]; + PROPERTIES, []; + PROTECTED, []; + PUSH_BUTTON, []; + QUERY_INDEX, []; + RADIO_BUTTON, []; + RAISED, []; + READERS, []; + READ_ONLY, []; + RECORD_DATA, []; + RECORD_OVERFLOW, []; + RECORD_TO_ADD, []; + RECORD_TO_DELETE, []; + RECURSIVE, [program_id_paragraph]; + REFRESH, []; + REGION_COLOR, []; + RELATION, [validate_status_clause]; + REORG_CRITERIA, []; + REQUIRED, [screen_descr_entry]; + REREAD, []; + RERUN, []; + RESET_GRID, []; + RESET_LIST, []; + RESET_TABS, []; + REVERSE_VIDEO, [screen_descr_entry; set_attribute_stmt]; + RIGHT_ALIGN, []; + RIMMED, []; + ROUNDING, [options_paragraph]; + ROW_COLOR, []; + ROW_COLOR_PATTERN, []; + ROW_DIVIDERS, []; + ROW_FONT, []; + ROW_HEADINGS, []; + ROW_PROTECTION, []; + S, []; + SAVE_AS, []; + SAVE_AS_NO_PROMPT, []; + SCROLL, []; + SCROLL_BAR, []; + SEARCH_OPTIONS, []; + SEARCH_TEXT, []; + SECONDS, [retry_phrase]; + SECURE, [screen_descr_entry]; + SELECTION_INDEX, []; + SELECTION_TEXT, []; + SELECT_ALL, []; + SELF_ACT, []; + SEPARATION, []; + SHADING, []; + SHADOW, []; + SHORT, [dynlen_struct_clause]; + SHOW_LINES, []; + SHOW_NONE, []; + SHOW_SEL_ALWAYS, []; + SIGNED, [dynlen_struct_clause; usage_clause]; + SORT_ORDER, []; + SPINNER, []; + SQUARE, []; + STACK, []; + STANDARD_BINARY, [arithmetic_clause]; + STANDARD_DECIMAL, [arithmetic_clause]; + START_X, []; + START_Y, []; + STATEMENT, [resume_stmt]; + STATIC, []; + STATIC_LIST, []; + STATUS_BAR, []; + STATUS_TEXT, []; + STDCALL, []; + STEP, [occurs_clause]; + STRONG, [typedef_clause]; + STRUCTURE, [dynlen_struct_clause]; + STYLE, []; + SYMBOL, [currency_clause]; + SYSTEM_INFO, []; + TAB, []; + TAB_TO_ADD, []; + TAB_TO_DELETE, []; + TAPE, []; + TEMPORARY, []; + TERMINAL_INFO, []; + TERMINATION_VALUE, []; + THREEDIMENSIONAL, []; + THUMB_POSITION, []; + TILED_HEADINGS, []; + TIME_OUT, []; + TITLE, []; + TITLE_POSITION, []; + TOP_LEVEL, []; + TOWARD_GREATER, [rounded_phrase]; + TOWARD_LESSER, [rounded_phrase]; + TRACK, []; + TRACKS, []; + TRACK_AREA, []; + TRACK_LIMIT, []; + TRAILING_SHIFT, []; + TRANSPARENT, []; + TREE_VIEW, []; + TRUNCATION, [intermediate_rounding_clause; rounded_phrase]; + U, []; + UCS_4, [alphabet_clause]; + UNBOUNDED, []; + UNDERLINE, [screen_descr_entry; set_attribute_stmt]; + UNFRAMED, []; + UNSIGNED, [usage_clause]; + UNSORTED, []; + UPDATERS, []; + UPPER, []; + USER, []; + USE_ALT, []; + USE_RETURN, []; + USE_TAB, []; + UTF_16, [alphabet_clause]; + UTF_8, [alphabet_clause]; + V, []; + VALIDATING, []; + VALUE_FORMAT, []; + VARIABLE, []; + VERTICAL, []; + VERY_HEAVY, []; + VIRTUAL_WIDTH, []; + VPADDING, []; + VSCROLL, []; + VSCROLL_BAR, []; + VSCROLL_POS, []; + VTOP, []; + WEB_BROWSER, []; + WIDTH, []; + WIDTH_IN_CELLS, []; + WRAP, []; + WRITERS, []; + WRITE_ONLY, []; + WRITE_VERIFY, []; + X, []; + XML_DECLARATION, []; + XML_SCHEMA, []; + Y, []; + YYYYDDD, [accept_stmt]; + YYYYMMDD, [accept_stmt]; + ZERO_FILL, []; + ] + in + List.fold_left (fun (acc, cstoks, unimpl) (t, add_contexts) -> + let h = Text_lexer.handle_of_token t in + List.fold_left (fun acc f -> f h acc) acc add_contexts, + TH.add h cstoks, + if add_contexts = [] then TH.add h unimpl else unimpl) + (empty, TH.empty, TH.empty) specs + +let accept_stmt = all.accept_stmt +let allocate_stmt = all.allocate_stmt +let alphabet_clause = all.alphabet_clause +let arithmetic_clause = all.arithmetic_clause +let class_specifier = all.class_specifier +let column_clause = all.column_clause +let constant = all.constant +let currency_clause = all.currency_clause +let default_clause = all.default_clause +let dynlen_struct_clause = all.dynlen_struct_clause +let entry_convention_clause = all.entry_convention_clause +let erase_clause = all.erase_clause +let exit_stmt = all.exit_stmt +let factory_paragraph = all.factory_paragraph +let float_binary_clause = all.float_binary_clause +let float_decimal_clause = all.float_decimal_clause +let function_specifier = all.function_specifier +let interface_specifier = all.interface_specifier +let intermediate_rounding_clause = all.intermediate_rounding_clause +let line_clause = all.line_clause +let lock_mode_clause = all.lock_mode_clause +let object_computer_paragraph = all.object_computer_paragraph +let object_paragraph = all.object_paragraph +let occurs_clause = all.occurs_clause +let options_paragrahp = all.options_paragrahp +let options_paragraph = all.options_paragraph +let options_pragraph = all.options_pragraph +let program_id_paragraph = all.program_id_paragraph +let read_statement = all.read_statement +let read_stmt = all.read_stmt +let resume_stmt = all.resume_stmt +let retry_phrase = all.retry_phrase +let rounded_phrase = all.rounded_phrase +let screen_descr_entry = all.screen_descr_entry +let screnn_descr_entry = all.screnn_descr_entry +let set_attribute_stmt = all.set_attribute_stmt +let set_stmt = all.set_stmt +let sharing_clause = all.sharing_clause +let sharing_phrase = all.sharing_phrase +let stop_stmt = all.stop_stmt +let typedef_clause = all.typedef_clause +let usage_clause = all.usage_clause +let validate_status_clause = all.validate_status_clause + diff --git a/src/lsp/cobol_parser/grammar_post_actions.ml b/src/lsp/cobol_parser/grammar_post_actions.ml new file mode 100644 index 000000000..0cffa25c7 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_post_actions.ml @@ -0,0 +1,45 @@ +(* Caution: this file was automatically generated from grammar.cmly; do not edit *) +[@@@warning "-33"] (* <- do not warn on unused opens *) +[@@@warning "-27"] (* <- do not warn on unused variabes *) + +module Make (Config: Cobol_config.T) = +struct + + open Grammar + open MenhirInterpreter + + type post_action = + | Post_diagnostic: (loc:Cobol_common.Srcloc.srcloc option -> unit + Cobol_common.Diagnostics.in_result) -> post_action + | Post_pending: (string) -> post_action + | Post_special_names: (Cobol_ast.special_names_clause) -> post_action + | NoPost: post_action + + let post_production_num + : type k. int -> k env -> post_action = fun prod_num env -> + match top env with + | None -> NoPost + | Some (Element (state, value, _, _)) -> + match incoming_symbol state, prod_num with + | N N__assign_external_, 2 -> + Post_pending ((fun () -> "EXTERNAL") value) + | N N_control_division, 335 -> + Post_diagnostic ((fun _ -> Config.control_division#verify) value) + | N N_special_names_clause, 2082 -> Post_special_names value + | N N_special_names_clause, 2083 -> Post_special_names value + | N N_special_names_clause, 2084 -> Post_special_names value + | N N_special_names_clause, 2085 -> Post_special_names value + | N N_special_names_clause, 2086 -> Post_special_names value + | N N_special_names_clause, 2087 -> Post_special_names value + | N N_special_names_clause, 2088 -> Post_special_names value + | N N_special_names_clause, 2089 -> Post_special_names value + | N N_special_names_clause, 2090 -> Post_special_names value + | N N_special_names_clause, 2091 -> Post_special_names value + | N N_special_names_clause, 2092 -> Post_special_names value + | _ -> NoPost + + let post_production + : type k. production -> k env -> post_action = fun p -> + post_production_num (production_index p) + +end diff --git a/src/lsp/cobol_parser/grammar_printer.ml b/src/lsp/cobol_parser/grammar_printer.ml new file mode 100644 index 000000000..9b0cb436c --- /dev/null +++ b/src/lsp/cobol_parser/grammar_printer.ml @@ -0,0 +1,6378 @@ +open Grammar +open Grammar_tokens + +let print_symbol = function + | MenhirInterpreter.X (MenhirInterpreter.T T_error) -> "error" + | MenhirInterpreter.X (MenhirInterpreter.T T_ZERO_FILL) -> "ZERO_FILL" + | MenhirInterpreter.X (MenhirInterpreter.T T_ZERO) -> "ZERO" + | MenhirInterpreter.X (MenhirInterpreter.T T_YYYYMMDD) -> "YYYYMMDD" + | MenhirInterpreter.X (MenhirInterpreter.T T_YYYYDDD) -> "YYYYDDD" + | MenhirInterpreter.X (MenhirInterpreter.T T_Y) -> "Y" + | MenhirInterpreter.X (MenhirInterpreter.T T_XOR) -> "XOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_XML_SCHEMA) -> "XML_SCHEMA" + | MenhirInterpreter.X (MenhirInterpreter.T T_XML_DECLARATION) -> "XML_DECLARATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_XML) -> "XML" + | MenhirInterpreter.X (MenhirInterpreter.T T_X) -> "X" + | MenhirInterpreter.X (MenhirInterpreter.T T_WRITE_VERIFY) -> "WRITE_VERIFY" + | MenhirInterpreter.X (MenhirInterpreter.T T_WRITE_ONLY) -> "WRITE_ONLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_WRITERS) -> "WRITERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_WRITE) -> "WRITE" + | MenhirInterpreter.X (MenhirInterpreter.T T_WRAP) -> "WRAP" + | MenhirInterpreter.X (MenhirInterpreter.T T_WORKING_STORAGE) -> "WORKING_STORAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_WORD_IN_AREA_A) -> "WORD_IN_AREA_A" + | MenhirInterpreter.X (MenhirInterpreter.T T_WORDS) -> "WORDS" + | MenhirInterpreter.X (MenhirInterpreter.T T_WORD) -> "WORD" + | MenhirInterpreter.X (MenhirInterpreter.T T_WITH_DATA) -> "WITH_DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_WITH) -> "WITH" + | MenhirInterpreter.X (MenhirInterpreter.T T_WINDOW) -> "WINDOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_WIDTH_IN_CELLS) -> "WIDTH_IN_CELLS" + | MenhirInterpreter.X (MenhirInterpreter.T T_WIDTH) -> "WIDTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_WHEN) -> "WHEN" + | MenhirInterpreter.X (MenhirInterpreter.T T_WEB_BROWSER) -> "WEB_BROWSER" + | MenhirInterpreter.X (MenhirInterpreter.T T_WAIT) -> "WAIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_VTOP) -> "VTOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_VSCROLL_POS) -> "VSCROLL_POS" + | MenhirInterpreter.X (MenhirInterpreter.T T_VSCROLL_BAR) -> "VSCROLL_BAR" + | MenhirInterpreter.X (MenhirInterpreter.T T_VSCROLL) -> "VSCROLL" + | MenhirInterpreter.X (MenhirInterpreter.T T_VPADDING) -> "VPADDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_VOLATILE) -> "VOLATILE" + | MenhirInterpreter.X (MenhirInterpreter.T T_VLR) -> "VLR" + | MenhirInterpreter.X (MenhirInterpreter.T T_VIRTUAL_WIDTH) -> "VIRTUAL_WIDTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_VIRTUAL) -> "VIRTUAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_VIA) -> "VIA" + | MenhirInterpreter.X (MenhirInterpreter.T T_VERY_HEAVY) -> "VERY_HEAVY" + | MenhirInterpreter.X (MenhirInterpreter.T T_VERTICAL) -> "VERTICAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_VARYING) -> "VARYING" + | MenhirInterpreter.X (MenhirInterpreter.T T_VARIANT) -> "VARIANT" + | MenhirInterpreter.X (MenhirInterpreter.T T_VARIABLE) -> "VARIABLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALUE_FORMAT) -> "VALUE_FORMAT" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALUES) -> "VALUES" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALUE) -> "VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALIDATING) -> "VALIDATING" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALIDATE_STATUS) -> "VALIDATE_STATUS" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALIDATE) -> "VALIDATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_VALID) -> "VALID" + | MenhirInterpreter.X (MenhirInterpreter.T T_V) -> "V" + | MenhirInterpreter.X (MenhirInterpreter.T T_UTF_8) -> "UTF_8" + | MenhirInterpreter.X (MenhirInterpreter.T T_UTF_16) -> "UTF_16" + | MenhirInterpreter.X (MenhirInterpreter.T T_USING) -> "USING" + | MenhirInterpreter.X (MenhirInterpreter.T T_USE_TAB) -> "USE_TAB" + | MenhirInterpreter.X (MenhirInterpreter.T T_USE_RETURN) -> "USE_RETURN" + | MenhirInterpreter.X (MenhirInterpreter.T T_USE_ALT) -> "USE_ALT" + | MenhirInterpreter.X (MenhirInterpreter.T T_USER_DEFAULT) -> "USER_DEFAULT" + | MenhirInterpreter.X (MenhirInterpreter.T T_USER) -> "USER" + | MenhirInterpreter.X (MenhirInterpreter.T T_USE) -> "USE" + | MenhirInterpreter.X (MenhirInterpreter.T T_USAGE) -> "USAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_UPPER) -> "UPPER" + | MenhirInterpreter.X (MenhirInterpreter.T T_UPON) -> "UPON" + | MenhirInterpreter.X (MenhirInterpreter.T T_UPDATERS) -> "UPDATERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_UPDATE) -> "UPDATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_UP) -> "UP" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNUSED__) -> "UNUSED__" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNTIL) -> "UNTIL" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSTRING) -> "UNSTRING" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSORTED) -> "UNSORTED" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSIGNED_SHORT) -> "UNSIGNED_SHORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSIGNED_LONG) -> "UNSIGNED_LONG" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSIGNED_INT) -> "UNSIGNED_INT" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSIGNED) -> "UNSIGNED" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNSEQUAL) -> "UNSEQUAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNLOCK) -> "UNLOCK" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNIVERSAL) -> "UNIVERSAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNIT) -> "UNIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNFRAMED) -> "UNFRAMED" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNDERLINE) -> "UNDERLINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_UNBOUNDED) -> "UNBOUNDED" + | MenhirInterpreter.X (MenhirInterpreter.T T_UFF) -> "UFF" + | MenhirInterpreter.X (MenhirInterpreter.T T_UCS_4) -> "UCS_4" + | MenhirInterpreter.X (MenhirInterpreter.T T_U) -> "U" + | MenhirInterpreter.X (MenhirInterpreter.T T_TYPEDEF) -> "TYPEDEF" + | MenhirInterpreter.X (MenhirInterpreter.T T_TYPE) -> "TYPE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRUNCATION) -> "TRUNCATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRUE) -> "TRUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TREE_VIEW) -> "TREE_VIEW" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRANSPARENT) -> "TRANSPARENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRANSFORM) -> "TRANSFORM" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRAILING_SIGN) -> "TRAILING_SIGN" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRAILING_SHIFT) -> "TRAILING_SHIFT" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRAILING) -> "TRAILING" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRADITIONAL_FONT) -> "TRADITIONAL_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRACK_LIMIT) -> "TRACK_LIMIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRACK_AREA) -> "TRACK_AREA" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRACKS) -> "TRACKS" + | MenhirInterpreter.X (MenhirInterpreter.T T_TRACK) -> "TRACK" + | MenhirInterpreter.X (MenhirInterpreter.T T_TOWARD_LESSER) -> "TOWARD_LESSER" + | MenhirInterpreter.X (MenhirInterpreter.T T_TOWARD_GREATER) -> "TOWARD_GREATER" + | MenhirInterpreter.X (MenhirInterpreter.T T_TOP_LEVEL) -> "TOP_LEVEL" + | MenhirInterpreter.X (MenhirInterpreter.T T_TOP) -> "TOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_TO) -> "TO" + | MenhirInterpreter.X (MenhirInterpreter.T T_TITLE_POSITION) -> "TITLE_POSITION" + | MenhirInterpreter.X (MenhirInterpreter.T T_TITLE) -> "TITLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TIME_OUT) -> "TIME_OUT" + | MenhirInterpreter.X (MenhirInterpreter.T T_TIMES) -> "TIMES" + | MenhirInterpreter.X (MenhirInterpreter.T T_TIME) -> "TIME" + | MenhirInterpreter.X (MenhirInterpreter.T T_TILED_HEADINGS) -> "TILED_HEADINGS" + | MenhirInterpreter.X (MenhirInterpreter.T T_THUMB_POSITION) -> "THUMB_POSITION" + | MenhirInterpreter.X (MenhirInterpreter.T T_THROUGH) -> "THROUGH" + | MenhirInterpreter.X (MenhirInterpreter.T T_THREEDIMENSIONAL) -> "THREEDIMENSIONAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_THREADS) -> "THREADS" + | MenhirInterpreter.X (MenhirInterpreter.T T_THREAD) -> "THREAD" + | MenhirInterpreter.X (MenhirInterpreter.T T_THEN) -> "THEN" + | MenhirInterpreter.X (MenhirInterpreter.T T_THAN) -> "THAN" + | MenhirInterpreter.X (MenhirInterpreter.T T_TEXT) -> "TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_TEST) -> "TEST" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINATION_VALUE) -> "TERMINATION_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINATE) -> "TERMINATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL_X) -> "TERMINAL_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL_INFO) -> "TERMINAL_INFO" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL_3) -> "TERMINAL_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL_2) -> "TERMINAL_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL_1) -> "TERMINAL_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL_0) -> "TERMINAL_0" + | MenhirInterpreter.X (MenhirInterpreter.T T_TERMINAL) -> "TERMINAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_TEMPORARY) -> "TEMPORARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_TEMP) -> "TEMP" + | MenhirInterpreter.X (MenhirInterpreter.T T_TAPE) -> "TAPE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TALLYING) -> "TALLYING" + | MenhirInterpreter.X (MenhirInterpreter.T T_TAB_TO_DELETE) -> "TAB_TO_DELETE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TAB_TO_ADD) -> "TAB_TO_ADD" + | MenhirInterpreter.X (MenhirInterpreter.T T_TABLE) -> "TABLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_TAB) -> "TAB" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSTEM_OFFSET) -> "SYSTEM_OFFSET" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSTEM_INFO) -> "SYSTEM_INFO" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSTEM_DEFAULT) -> "SYSTEM_DEFAULT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSTEM) -> "SYSTEM" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSOUT_X) -> "SYSOUT_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSOUT_3) -> "SYSOUT_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSOUT_2) -> "SYSOUT_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSOUT_1) -> "SYSOUT_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSOUT_0) -> "SYSOUT_0" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSIN_X) -> "SYSIN_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSIN_3) -> "SYSIN_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSIN_2) -> "SYSIN_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSIN_1) -> "SYSIN_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYSIN_0) -> "SYSIN_0" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYNCHRONIZED) -> "SYNCHRONIZED" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYMBOLIC) -> "SYMBOLIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_SYMBOL) -> "SYMBOL" + | MenhirInterpreter.X (MenhirInterpreter.T T_SWITCH) -> "SWITCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUPPRESS) -> "SUPPRESS" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUPER) -> "SUPER" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUM) -> "SUM" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUB_SCHEMA) -> "SUB_SCHEMA" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUB_QUEUE_3) -> "SUB_QUEUE_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUB_QUEUE_2) -> "SUB_QUEUE_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUB_QUEUE_1) -> "SUB_QUEUE_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUBWINDOW) -> "SUBWINDOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_SUBTRACT) -> "SUBTRACT" + | MenhirInterpreter.X (MenhirInterpreter.T T_STYLE) -> "STYLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_STRUCTURE) -> "STRUCTURE" + | MenhirInterpreter.X (MenhirInterpreter.T T_STRONG) -> "STRONG" + | MenhirInterpreter.X (MenhirInterpreter.T T_STRING) -> "STRING" + | MenhirInterpreter.X (MenhirInterpreter.T T_STOP) -> "STOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_STEP) -> "STEP" + | MenhirInterpreter.X (MenhirInterpreter.T T_STDCALL) -> "STDCALL" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATUS_TEXT) -> "STATUS_TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATUS_BAR) -> "STATUS_BAR" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATUS) -> "STATUS" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATION) -> "STATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATIC_LIST) -> "STATIC_LIST" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATIC) -> "STATIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_STATEMENT) -> "STATEMENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_START_Y) -> "START_Y" + | MenhirInterpreter.X (MenhirInterpreter.T T_START_X) -> "START_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_START) -> "START" + | MenhirInterpreter.X (MenhirInterpreter.T T_STANDARD_DECIMAL) -> "STANDARD_DECIMAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_STANDARD_BINARY) -> "STANDARD_BINARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_STANDARD_2) -> "STANDARD_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_STANDARD_1) -> "STANDARD_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_STANDARD) -> "STANDARD" + | MenhirInterpreter.X (MenhirInterpreter.T T_STACK) -> "STACK" + | MenhirInterpreter.X (MenhirInterpreter.T T_SSF) -> "SSF" + | MenhirInterpreter.X (MenhirInterpreter.T T_SQUARE) -> "SQUARE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SPINNER) -> "SPINNER" + | MenhirInterpreter.X (MenhirInterpreter.T T_SPECIAL_NAMES) -> "SPECIAL_NAMES" + | MenhirInterpreter.X (MenhirInterpreter.T T_SPACE_FILL) -> "SPACE_FILL" + | MenhirInterpreter.X (MenhirInterpreter.T T_SPACE) -> "SPACE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SOURCE_COMPUTER) -> "SOURCE_COMPUTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_SOURCES) -> "SOURCES" + | MenhirInterpreter.X (MenhirInterpreter.T T_SOURCE) -> "SOURCE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SORT_ORDER) -> "SORT_ORDER" + | MenhirInterpreter.X (MenhirInterpreter.T T_SORT_MERGE) -> "SORT_MERGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SORT) -> "SORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SMALL_FONT) -> "SMALL_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SLASH) -> "/" + | MenhirInterpreter.X (MenhirInterpreter.T T_SIZE) -> "SIZE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SINTLIT) -> "SINTLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SIGNED_SHORT) -> "SIGNED_SHORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SIGNED_LONG) -> "SIGNED_LONG" + | MenhirInterpreter.X (MenhirInterpreter.T T_SIGNED_INT) -> "SIGNED_INT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SIGNED) -> "SIGNED" + | MenhirInterpreter.X (MenhirInterpreter.T T_SIGN) -> "SIGN" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHOW_SEL_ALWAYS) -> "SHOW_SEL_ALWAYS" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHOW_NONE) -> "SHOW_NONE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHOW_LINES) -> "SHOW_LINES" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHORT_DATE) -> "SHORT_DATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHORT) -> "SHORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHARING) -> "SHARING" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHADOW) -> "SHADOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_SHADING) -> "SHADING" + | MenhirInterpreter.X (MenhirInterpreter.T T_SET) -> "SET" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEQUENTIAL) -> "SEQUENTIAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEQUENCE) -> "SEQUENCE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEPARATION) -> "SEPARATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEPARATE) -> "SEPARATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SENTENCE) -> "SENTENCE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEND) -> "SEND" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELF_ACT) -> "SELF_ACT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELF) -> "SELF" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELECT_ALL) -> "SELECT_ALL" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELECTION_TEXT) -> "SELECTION_TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELECTION_INDEX) -> "SELECTION_INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELECTION) -> "SELECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_SELECT) -> "SELECT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEGMENT_LIMIT) -> "SEGMENT_LIMIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEGMENT) -> "SEGMENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SECURITY) -> "SECURITY" + | MenhirInterpreter.X (MenhirInterpreter.T T_SECURE) -> "SECURE" + | MenhirInterpreter.X (MenhirInterpreter.T T_SECTION) -> "SECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_SECONDS) -> "SECONDS" + | MenhirInterpreter.X (MenhirInterpreter.T T_SECONDARY) -> "SECONDARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEARCH_TEXT) -> "SEARCH_TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEARCH_OPTIONS) -> "SEARCH_OPTIONS" + | MenhirInterpreter.X (MenhirInterpreter.T T_SEARCH) -> "SEARCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_SD) -> "SD" + | MenhirInterpreter.X (MenhirInterpreter.T T_SCROLL_BAR) -> "SCROLL_BAR" + | MenhirInterpreter.X (MenhirInterpreter.T T_SCROLL) -> "SCROLL" + | MenhirInterpreter.X (MenhirInterpreter.T T_SCREEN) -> "SCREEN" + | MenhirInterpreter.X (MenhirInterpreter.T T_SAVE_AS_NO_PROMPT) -> "SAVE_AS_NO_PROMPT" + | MenhirInterpreter.X (MenhirInterpreter.T T_SAVE_AS) -> "SAVE_AS" + | MenhirInterpreter.X (MenhirInterpreter.T T_SARF) -> "SARF" + | MenhirInterpreter.X (MenhirInterpreter.T T_SAME) -> "SAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_S) -> "S" + | MenhirInterpreter.X (MenhirInterpreter.T T_RUN) -> "RUN" + | MenhirInterpreter.X (MenhirInterpreter.T T_RPAR) -> ")" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROW_PROTECTION) -> "ROW_PROTECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROW_HEADINGS) -> "ROW_HEADINGS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROW_FONT) -> "ROW_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROW_DIVIDERS) -> "ROW_DIVIDERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROW_COLOR_PATTERN) -> "ROW_COLOR_PATTERN" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROW_COLOR) -> "ROW_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROUNDING) -> "ROUNDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROUNDED) -> "ROUNDED" + | MenhirInterpreter.X (MenhirInterpreter.T T_ROLLBACK) -> "ROLLBACK" + | MenhirInterpreter.X (MenhirInterpreter.T T_RIMMED) -> "RIMMED" + | MenhirInterpreter.X (MenhirInterpreter.T T_RIGHT_JUSTIFY) -> "RIGHT_JUSTIFY" + | MenhirInterpreter.X (MenhirInterpreter.T T_RIGHT_ALIGN) -> "RIGHT_ALIGN" + | MenhirInterpreter.X (MenhirInterpreter.T T_RIGHT) -> "RIGHT" + | MenhirInterpreter.X (MenhirInterpreter.T T_RH) -> "RH" + | MenhirInterpreter.X (MenhirInterpreter.T T_RF) -> "RF" + | MenhirInterpreter.X (MenhirInterpreter.T T_REWRITE) -> "REWRITE" + | MenhirInterpreter.X (MenhirInterpreter.T T_REWIND) -> "REWIND" + | MenhirInterpreter.X (MenhirInterpreter.T T_REVERSE_VIDEO) -> "REVERSE_VIDEO" + | MenhirInterpreter.X (MenhirInterpreter.T T_REVERSED) -> "REVERSED" + | MenhirInterpreter.X (MenhirInterpreter.T T_REVERSE) -> "REVERSE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RETURNING) -> "RETURNING" + | MenhirInterpreter.X (MenhirInterpreter.T T_RETURN) -> "RETURN" + | MenhirInterpreter.X (MenhirInterpreter.T T_RETRY) -> "RETRY" + | MenhirInterpreter.X (MenhirInterpreter.T T_RETENTION) -> "RETENTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_RESUME) -> "RESUME" + | MenhirInterpreter.X (MenhirInterpreter.T T_RESET_TABS) -> "RESET_TABS" + | MenhirInterpreter.X (MenhirInterpreter.T T_RESET_LIST) -> "RESET_LIST" + | MenhirInterpreter.X (MenhirInterpreter.T T_RESET_GRID) -> "RESET_GRID" + | MenhirInterpreter.X (MenhirInterpreter.T T_RESET) -> "RESET" + | MenhirInterpreter.X (MenhirInterpreter.T T_RESERVE) -> "RESERVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RERUN) -> "RERUN" + | MenhirInterpreter.X (MenhirInterpreter.T T_REREAD) -> "REREAD" + | MenhirInterpreter.X (MenhirInterpreter.T T_REQUIRED) -> "REQUIRED" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPOSITORY) -> "REPOSITORY" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPORTS) -> "REPORTS" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPORTING) -> "REPORTING" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPORT) -> "REPORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPLACING) -> "REPLACING" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPLACE) -> "REPLACE" + | MenhirInterpreter.X (MenhirInterpreter.T T_REPEATED) -> "REPEATED" + | MenhirInterpreter.X (MenhirInterpreter.T T_REORG_CRITERIA) -> "REORG_CRITERIA" + | MenhirInterpreter.X (MenhirInterpreter.T T_RENAMES) -> "RENAMES" + | MenhirInterpreter.X (MenhirInterpreter.T T_REMOVAL) -> "REMOVAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_REMARKS) -> "REMARKS" + | MenhirInterpreter.X (MenhirInterpreter.T T_REMAINDER) -> "REMAINDER" + | MenhirInterpreter.X (MenhirInterpreter.T T_RELEASE) -> "RELEASE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RELATIVE) -> "RELATIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RELATION) -> "RELATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_REGION_COLOR) -> "REGION_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_REFRESH) -> "REFRESH" + | MenhirInterpreter.X (MenhirInterpreter.T T_REFERENCES) -> "REFERENCES" + | MenhirInterpreter.X (MenhirInterpreter.T T_REFERENCE) -> "REFERENCE" + | MenhirInterpreter.X (MenhirInterpreter.T T_REEL) -> "REEL" + | MenhirInterpreter.X (MenhirInterpreter.T T_REDEFINES) -> "REDEFINES" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECURSIVE) -> "RECURSIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORD_TO_DELETE) -> "RECORD_TO_DELETE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORD_TO_ADD) -> "RECORD_TO_ADD" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORD_OVERFLOW) -> "RECORD_OVERFLOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORD_DATA) -> "RECORD_DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORDS) -> "RECORDS" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORDING) -> "RECORDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECORD) -> "RECORD" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECEIVED) -> "RECEIVED" + | MenhirInterpreter.X (MenhirInterpreter.T T_RECEIVE) -> "RECEIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_READ_ONLY) -> "READ_ONLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_READERS) -> "READERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_READ) -> "READ" + | MenhirInterpreter.X (MenhirInterpreter.T T_RD) -> "RD" + | MenhirInterpreter.X (MenhirInterpreter.T T_RANDOM) -> "RANDOM" + | MenhirInterpreter.X (MenhirInterpreter.T T_RAISING) -> "RAISING" + | MenhirInterpreter.X (MenhirInterpreter.T T_RAISED) -> "RAISED" + | MenhirInterpreter.X (MenhirInterpreter.T T_RAISE) -> "RAISE" + | MenhirInterpreter.X (MenhirInterpreter.T T_RADIO_BUTTON) -> "RADIO_BUTTON" + | MenhirInterpreter.X (MenhirInterpreter.T T_QUOTE) -> "QUOTE" + | MenhirInterpreter.X (MenhirInterpreter.T T_QUEUED) -> "QUEUED" + | MenhirInterpreter.X (MenhirInterpreter.T T_QUEUE) -> "QUEUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_QUERY_INDEX) -> "QUERY_INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_PUSH_BUTTON) -> "PUSH_BUTTON" + | MenhirInterpreter.X (MenhirInterpreter.T T_PURGE) -> "PURGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROTOTYPE) -> "PROTOTYPE" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROTECTED) -> "PROTECTED" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROPERTY) -> "PROPERTY" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROPERTIES) -> "PROPERTIES" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROMPT) -> "PROMPT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROHIBITED) -> "PROHIBITED" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROGRESS) -> "PROGRESS" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROGRAM_POINTER) -> "PROGRAM_POINTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROGRAM_ID) -> "PROGRAM_ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROGRAM) -> "PROGRAM" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROCESS_AREA) -> "PROCESS_AREA" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROCESSING) -> "PROCESSING" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROCEED) -> "PROCEED" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROCEDURE_POINTER) -> "PROCEDURE_POINTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROCEDURES) -> "PROCEDURES" + | MenhirInterpreter.X (MenhirInterpreter.T T_PROCEDURE) -> "PROCEDURE" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRIORITY) -> "PRIORITY" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRINT_PREVIEW) -> "PRINT_PREVIEW" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRINT_NO_PROMPT) -> "PRINT_NO_PROMPT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRINTING) -> "PRINTING" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRINTER_1) -> "PRINTER_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRINTER) -> "PRINTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRINT) -> "PRINT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRIMARY) -> "PRIMARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_PREVIOUS) -> "PREVIOUS" + | MenhirInterpreter.X (MenhirInterpreter.T T_PRESENT) -> "PRESENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PREFIXED) -> "PREFIXED" + | MenhirInterpreter.X (MenhirInterpreter.T T_POSITIVE) -> "POSITIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_POSITION_SHIFT) -> "POSITION_SHIFT" + | MenhirInterpreter.X (MenhirInterpreter.T T_POSITION) -> "POSITION" + | MenhirInterpreter.X (MenhirInterpreter.T T_POS) -> "POS" + | MenhirInterpreter.X (MenhirInterpreter.T T_POP_UP) -> "POP_UP" + | MenhirInterpreter.X (MenhirInterpreter.T T_POINTER) -> "POINTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_PLUS_SIGN) -> "+" + | MenhirInterpreter.X (MenhirInterpreter.T T_PLUS) -> "PLUS" + | MenhirInterpreter.X (MenhirInterpreter.T T_PLACEMENT) -> "PLACEMENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PIXEL) -> "PIXEL" + | MenhirInterpreter.X (MenhirInterpreter.T T_PICTURE_STRING) -> "PICTURE_STRING" + | MenhirInterpreter.X (MenhirInterpreter.T T_PICTURE) -> "PICTURE" + | MenhirInterpreter.X (MenhirInterpreter.T T_PHYSICAL) -> "PHYSICAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_PH) -> "PH" + | MenhirInterpreter.X (MenhirInterpreter.T T_PF) -> "PF" + | MenhirInterpreter.X (MenhirInterpreter.T T_PERMANENT) -> "PERMANENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PERIOD) -> "." + | MenhirInterpreter.X (MenhirInterpreter.T T_PERFORM) -> "PERFORM" + | MenhirInterpreter.X (MenhirInterpreter.T T_PASSWORD) -> "PASSWORD" + | MenhirInterpreter.X (MenhirInterpreter.T T_PASCAL) -> "PASCAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_PARSE) -> "PARSE" + | MenhirInterpreter.X (MenhirInterpreter.T T_PARENT) -> "PARENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_PARAGRAPH) -> "PARAGRAPH" + | MenhirInterpreter.X (MenhirInterpreter.T T_PAGE_SETUP) -> "PAGE_SETUP" + | MenhirInterpreter.X (MenhirInterpreter.T T_PAGE_COUNTER) -> "PAGE_COUNTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_PAGED) -> "PAGED" + | MenhirInterpreter.X (MenhirInterpreter.T T_PAGE) -> "PAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_PADDING) -> "PADDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_PACKED_DECIMAL) -> "PACKED_DECIMAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_OVERRIDING) -> "OVERRIDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_OVERRIDE) -> "OVERRIDE" + | MenhirInterpreter.X (MenhirInterpreter.T T_OVERLINE) -> "OVERLINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_OVERLAP_TOP) -> "OVERLAP_TOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_OVERLAP_LEFT) -> "OVERLAP_LEFT" + | MenhirInterpreter.X (MenhirInterpreter.T T_OVERFLOW) -> "OVERFLOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_OUTPUT) -> "OUTPUT" + | MenhirInterpreter.X (MenhirInterpreter.T T_OTHERS) -> "OTHERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_OTHER) -> "OTHER" + | MenhirInterpreter.X (MenhirInterpreter.T T_ORGANIZATION) -> "ORGANIZATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ORDER) -> "ORDER" + | MenhirInterpreter.X (MenhirInterpreter.T T_OR) -> "OR" + | MenhirInterpreter.X (MenhirInterpreter.T T_OPTIONS) -> "OPTIONS" + | MenhirInterpreter.X (MenhirInterpreter.T T_OPTIONAL) -> "OPTIONAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_OPERATIONAL) -> "OPERATIONAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_OPEN) -> "OPEN" + | MenhirInterpreter.X (MenhirInterpreter.T T_ON_SIZE_ERROR) -> "ON_SIZE_ERROR" + | MenhirInterpreter.X (MenhirInterpreter.T T_ON_OVERFLOW) -> "ON_OVERFLOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_ON_EXCEPTION) -> "ON_EXCEPTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ONLY) -> "ONLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_ON) -> "ON" + | MenhirInterpreter.X (MenhirInterpreter.T T_OMITTED) -> "OMITTED" + | MenhirInterpreter.X (MenhirInterpreter.T T_OK_BUTTON) -> "OK_BUTTON" + | MenhirInterpreter.X (MenhirInterpreter.T T_OFF) -> "OFF" + | MenhirInterpreter.X (MenhirInterpreter.T T_OF) -> "OF" + | MenhirInterpreter.X (MenhirInterpreter.T T_OCCURS) -> "OCCURS" + | MenhirInterpreter.X (MenhirInterpreter.T T_OBJECT_REFERENCE) -> "OBJECT_REFERENCE" + | MenhirInterpreter.X (MenhirInterpreter.T T_OBJECT_PROGRAM) -> "OBJECT_PROGRAM" + | MenhirInterpreter.X (MenhirInterpreter.T T_OBJECT_COMPUTER) -> "OBJECT_COMPUTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_OBJECT) -> "OBJECT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NUM_ROWS) -> "NUM_ROWS" + | MenhirInterpreter.X (MenhirInterpreter.T T_NUM_COL_HEADINGS) -> "NUM_COL_HEADINGS" + | MenhirInterpreter.X (MenhirInterpreter.T T_NUMERIC_EDITED) -> "NUMERIC_EDITED" + | MenhirInterpreter.X (MenhirInterpreter.T T_NUMERIC) -> "NUMERIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_NUMBERS) -> "NUMBERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_NUMBER) -> "NUMBER" + | MenhirInterpreter.X (MenhirInterpreter.T T_NULLS) -> "NULLS" + | MenhirInterpreter.X (MenhirInterpreter.T T_NULLIT) -> "NULLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NULL) -> "NULL" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_UPDOWN) -> "NO_UPDOWN" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_SEARCH) -> "NO_SEARCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_KEY_LETTER) -> "NO_KEY_LETTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_GROUP_TAB) -> "NO_GROUP_TAB" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_FOCUS) -> "NO_FOCUS" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_F4) -> "NO_F4" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_ECHO) -> "NO_ECHO" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_DIVIDERS) -> "NO_DIVIDERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_DATA) -> "NO_DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_BOX) -> "NO_BOX" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_AUTO_DEFAULT) -> "NO_AUTO_DEFAULT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO_AUTOSEL) -> "NO_AUTOSEL" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT_ON_SIZE_ERROR) -> "NOT_ON_SIZE_ERROR" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT_ON_OVERFLOW) -> "NOT_ON_OVERFLOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT_ON_EXCEPTION) -> "NOT_ON_EXCEPTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT_INVALID_KEY) -> "NOT_INVALID_KEY" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT_AT_EOP) -> "NOT_AT_EOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT_AT_END) -> "NOT_AT_END" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOTIFY_SELCHANGE) -> "NOTIFY_SELCHANGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOTIFY_DBLCLICK) -> "NOTIFY_DBLCLICK" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOTIFY_CHANGE) -> "NOTIFY_CHANGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOTIFY) -> "NOTIFY" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOTHING) -> "NOTHING" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOTAB) -> "NOTAB" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOT) -> "NOT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NORMAL) -> "NORMAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_NONNUMERIC) -> "NONNUMERIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_NONE) -> "NONE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NOMINAL) -> "NOMINAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_NO) -> "NO" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEXT_PAGE) -> "NEXT_PAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEXT_ITEM) -> "NEXT_ITEM" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEXT) -> "NEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEW) -> "NEW" + | MenhirInterpreter.X (MenhirInterpreter.T T_NESTED) -> "NESTED" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEGATIVE) -> "NEGATIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEAREST_TO_ZERO) -> "NEAREST_TO_ZERO" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEAREST_TOWARD_ZERO) -> "NEAREST_TOWARD_ZERO" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEAREST_EVEN) -> "NEAREST_EVEN" + | MenhirInterpreter.X (MenhirInterpreter.T T_NEAREST_AWAY_FROM_ZERO) -> "NEAREST_AWAY_FROM_ZERO" + | MenhirInterpreter.X (MenhirInterpreter.T T_NE) -> "<>" + | MenhirInterpreter.X (MenhirInterpreter.T T_NAVIGATE_URL) -> "NAVIGATE_URL" + | MenhirInterpreter.X (MenhirInterpreter.T T_NATLIT) -> "NATLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NATIVE) -> "NATIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NATIONAL_EDITED) -> "NATIONAL_EDITED" + | MenhirInterpreter.X (MenhirInterpreter.T T_NATIONAL) -> "NATIONAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_NAT) -> "NAT" + | MenhirInterpreter.X (MenhirInterpreter.T T_NAMESPACE_PREFIX) -> "NAMESPACE_PREFIX" + | MenhirInterpreter.X (MenhirInterpreter.T T_NAMESPACE) -> "NAMESPACE" + | MenhirInterpreter.X (MenhirInterpreter.T T_NAMED) -> "NAMED" + | MenhirInterpreter.X (MenhirInterpreter.T T_NAME) -> "NAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_MULTIPLY) -> "MULTIPLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_MULTIPLE) -> "MULTIPLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MULTILINE) -> "MULTILINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MOVE) -> "MOVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MODULES) -> "MODULES" + | MenhirInterpreter.X (MenhirInterpreter.T T_MODIFY) -> "MODIFY" + | MenhirInterpreter.X (MenhirInterpreter.T T_MODE) -> "MODE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MIN_VAL) -> "MIN_VAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_MINUS) -> "MINUS" + | MenhirInterpreter.X (MenhirInterpreter.T T_MICROSECOND_TIME) -> "MICROSECOND_TIME" + | MenhirInterpreter.X (MenhirInterpreter.T T_METHOD_ID) -> "METHOD_ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_METHOD) -> "METHOD" + | MenhirInterpreter.X (MenhirInterpreter.T T_MESSAGE_TAG) -> "MESSAGE_TAG" + | MenhirInterpreter.X (MenhirInterpreter.T T_MESSAGE) -> "MESSAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MERGE) -> "MERGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MENU) -> "MENU" + | MenhirInterpreter.X (MenhirInterpreter.T T_MEMORY) -> "MEMORY" + | MenhirInterpreter.X (MenhirInterpreter.T T_MEDIUM_FONT) -> "MEDIUM_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_MAX_VAL) -> "MAX_VAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_MAX_TEXT) -> "MAX_TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_MAX_PROGRESS) -> "MAX_PROGRESS" + | MenhirInterpreter.X (MenhirInterpreter.T T_MAX_LINES) -> "MAX_LINES" + | MenhirInterpreter.X (MenhirInterpreter.T T_MASTER_INDEX) -> "MASTER_INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_MASS_UPDATE) -> "MASS_UPDATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_MANUAL) -> "MANUAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_MAGNETIC_TAPE) -> "MAGNETIC_TAPE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LT) -> "<" + | MenhirInterpreter.X (MenhirInterpreter.T T_LPAR) -> "(" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOW_VALUE) -> "LOW_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOW_COLOR) -> "LOW_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOWLIGHT) -> "LOWLIGHT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOWERED) -> "LOWERED" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOWER) -> "LOWER" + | MenhirInterpreter.X (MenhirInterpreter.T T_LONG_DATE) -> "LONG_DATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOCK_HOLDING) -> "LOCK_HOLDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOCKS) -> "LOCKS" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOCK) -> "LOCK" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOCATION) -> "LOCATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOCAL_STORAGE) -> "LOCAL_STORAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOCALE) -> "LOCALE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LOC) -> "LOC" + | MenhirInterpreter.X (MenhirInterpreter.T T_LM_RESIZE) -> "LM_RESIZE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LIST_BOX) -> "LIST_BOX" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINKAGE) -> "LINKAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINE_SEQUENTIAL) -> "LINE_SEQUENTIAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINE_COUNTER) -> "LINE_COUNTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINES_PER_PAGE) -> "LINES_PER_PAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINES_AT_ROOT) -> "LINES_AT_ROOT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINES) -> "LINES" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINE) -> "LINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINAGE_COUNTER) -> "LINAGE_COUNTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_LINAGE) -> "LINAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LIMITS) -> "LIMITS" + | MenhirInterpreter.X (MenhirInterpreter.T T_LIMIT) -> "LIMIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LIKE) -> "LIKE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LIBRARY) -> "LIBRARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_LESS) -> "LESS" + | MenhirInterpreter.X (MenhirInterpreter.T T_LENGTH) -> "LENGTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEFT_TEXT) -> "LEFT_TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEFT_JUSTIFY) -> "LEFT_JUSTIFY" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEFTLINE) -> "LEFTLINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEFT) -> "LEFT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEAVE) -> "LEAVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEADING_SHIFT) -> "LEADING_SHIFT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LEADING) -> "LEADING" + | MenhirInterpreter.X (MenhirInterpreter.T T_LE) -> "<=" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_TIME) -> "LC_TIME" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_NUMERIC) -> "LC_NUMERIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_MONETARY) -> "LC_MONETARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_MESSAGES) -> "LC_MESSAGES" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_CTYPE) -> "LC_CTYPE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_COLLATE) -> "LC_COLLATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_LC_ALL) -> "LC_ALL" + | MenhirInterpreter.X (MenhirInterpreter.T T_LAYOUT_MANAGER) -> "LAYOUT_MANAGER" + | MenhirInterpreter.X (MenhirInterpreter.T T_LAYOUT_DATA) -> "LAYOUT_DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_LAST_ROW) -> "LAST_ROW" + | MenhirInterpreter.X (MenhirInterpreter.T T_LAST) -> "LAST" + | MenhirInterpreter.X (MenhirInterpreter.T T_LARGE_OFFSET) -> "LARGE_OFFSET" + | MenhirInterpreter.X (MenhirInterpreter.T T_LARGE_FONT) -> "LARGE_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_LABEL_OFFSET) -> "LABEL_OFFSET" + | MenhirInterpreter.X (MenhirInterpreter.T T_LABEL) -> "LABEL" + | MenhirInterpreter.X (MenhirInterpreter.T T_KEY_LOCATION) -> "KEY_LOCATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_KEYED) -> "KEYED" + | MenhirInterpreter.X (MenhirInterpreter.T T_KEYBOARD) -> "KEYBOARD" + | MenhirInterpreter.X (MenhirInterpreter.T T_KEY) -> "KEY" + | MenhirInterpreter.X (MenhirInterpreter.T T_KEPT) -> "KEPT" + | MenhirInterpreter.X (MenhirInterpreter.T T_JUSTIFIED) -> "JUSTIFIED" + | MenhirInterpreter.X (MenhirInterpreter.T T_JSON) -> "JSON" + | MenhirInterpreter.X (MenhirInterpreter.T T_I_O_CONTROL) -> "I_O_CONTROL" + | MenhirInterpreter.X (MenhirInterpreter.T T_I_O) -> "I_O" + | MenhirInterpreter.X (MenhirInterpreter.T T_ITEM_VALUE) -> "ITEM_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ITEM_TO_EMPTY) -> "ITEM_TO_EMPTY" + | MenhirInterpreter.X (MenhirInterpreter.T T_ITEM_TO_DELETE) -> "ITEM_TO_DELETE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ITEM_TO_ADD) -> "ITEM_TO_ADD" + | MenhirInterpreter.X (MenhirInterpreter.T T_ITEM_TEXT) -> "ITEM_TEXT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ITEM) -> "ITEM" + | MenhirInterpreter.X (MenhirInterpreter.T T_IS_TYPEDEF) -> "IS_TYPEDEF" + | MenhirInterpreter.X (MenhirInterpreter.T T_IS_GLOBAL) -> "IS_GLOBAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_IS_EXTERNAL) -> "IS_EXTERNAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_IS) -> "IS" + | MenhirInterpreter.X (MenhirInterpreter.T T_IN_ARITHMETIC_RANGE) -> "IN_ARITHMETIC_RANGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INVOKING) -> "INVOKING" + | MenhirInterpreter.X (MenhirInterpreter.T T_INVOKE) -> "INVOKE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INVALID_KEY) -> "INVALID_KEY" + | MenhirInterpreter.X (MenhirInterpreter.T T_INVALID) -> "INVALID" + | MenhirInterpreter.X (MenhirInterpreter.T T_INTRINSIC) -> "INTRINSIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_INTO) -> "INTO" + | MenhirInterpreter.X (MenhirInterpreter.T T_INTERVENING_) -> "INTERVENING_" + | MenhirInterpreter.X (MenhirInterpreter.T T_INTERMEDIATE) -> "INTERMEDIATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INTERFACE_ID) -> "INTERFACE_ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_INTERFACE) -> "INTERFACE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INSTALLATION) -> "INSTALLATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_INSPECT) -> "INSPECT" + | MenhirInterpreter.X (MenhirInterpreter.T T_INSERT_ROWS) -> "INSERT_ROWS" + | MenhirInterpreter.X (MenhirInterpreter.T T_INSERTION_INDEX) -> "INSERTION_INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_INQUIRE) -> "INQUIRE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INPUT_OUTPUT) -> "INPUT_OUTPUT" + | MenhirInterpreter.X (MenhirInterpreter.T T_INPUT) -> "INPUT" + | MenhirInterpreter.X (MenhirInterpreter.T T_INITIATE) -> "INITIATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INITIALIZED) -> "INITIALIZED" + | MenhirInterpreter.X (MenhirInterpreter.T T_INITIALIZE) -> "INITIALIZE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INITIAL) -> "INITIAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_INHERITS) -> "INHERITS" + | MenhirInterpreter.X (MenhirInterpreter.T T_INDICATE) -> "INDICATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_INDEX_2) -> "INDEX_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_INDEX_1) -> "INDEX_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_INDEXED) -> "INDEXED" + | MenhirInterpreter.X (MenhirInterpreter.T T_INDEX) -> "INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_INDEPENDENT) -> "INDEPENDENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_IN) -> "IN" + | MenhirInterpreter.X (MenhirInterpreter.T T_IMPLEMENTS) -> "IMPLEMENTS" + | MenhirInterpreter.X (MenhirInterpreter.T T_IGNORING) -> "IGNORING" + | MenhirInterpreter.X (MenhirInterpreter.T T_IGNORE) -> "IGNORE" + | MenhirInterpreter.X (MenhirInterpreter.T T_IF) -> "IF" + | MenhirInterpreter.X (MenhirInterpreter.T T_IDS_II) -> "IDS_II" + | MenhirInterpreter.X (MenhirInterpreter.T T_IDENTIFIED) -> "IDENTIFIED" + | MenhirInterpreter.X (MenhirInterpreter.T T_IDENTIFICATION) -> "IDENTIFICATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ID) -> "ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_ICON) -> "ICON" + | MenhirInterpreter.X (MenhirInterpreter.T T_HSCROLL_POS) -> "HSCROLL_POS" + | MenhirInterpreter.X (MenhirInterpreter.T T_HSCROLL) -> "HSCROLL" + | MenhirInterpreter.X (MenhirInterpreter.T T_HOT_TRACK) -> "HOT_TRACK" + | MenhirInterpreter.X (MenhirInterpreter.T T_HIGH_VALUE) -> "HIGH_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_HIGH_ORDER_RIGHT) -> "HIGH_ORDER_RIGHT" + | MenhirInterpreter.X (MenhirInterpreter.T T_HIGH_ORDER_LEFT) -> "HIGH_ORDER_LEFT" + | MenhirInterpreter.X (MenhirInterpreter.T T_HIGH_COLOR) -> "HIGH_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_HIGHLIGHT) -> "HIGHLIGHT" + | MenhirInterpreter.X (MenhirInterpreter.T T_HIDDEN_DATA) -> "HIDDEN_DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEXLIT) -> "HEXLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEX) -> "HEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEIGHT_IN_CELLS) -> "HEIGHT_IN_CELLS" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEAVY) -> "HEAVY" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEADING_FONT) -> "HEADING_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEADING_DIVIDER_COLOR) -> "HEADING_DIVIDER_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEADING_COLOR) -> "HEADING_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_HEADING) -> "HEADING" + | MenhirInterpreter.X (MenhirInterpreter.T T_HAS_CHILDREN) -> "HAS_CHILDREN" + | MenhirInterpreter.X (MenhirInterpreter.T T_HANDLE) -> "HANDLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_GT) -> ">" + | MenhirInterpreter.X (MenhirInterpreter.T T_GROUP_VALUE) -> "GROUP_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_GROUP_USAGE) -> "GROUP_USAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_GROUP) -> "GROUP" + | MenhirInterpreter.X (MenhirInterpreter.T T_GRID) -> "GRID" + | MenhirInterpreter.X (MenhirInterpreter.T T_GREATER) -> "GREATER" + | MenhirInterpreter.X (MenhirInterpreter.T T_GRAPHICAL) -> "GRAPHICAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_GO_SEARCH) -> "GO_SEARCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_GO_HOME) -> "GO_HOME" + | MenhirInterpreter.X (MenhirInterpreter.T T_GO_FORWARD) -> "GO_FORWARD" + | MenhirInterpreter.X (MenhirInterpreter.T T_GO_BACK) -> "GO_BACK" + | MenhirInterpreter.X (MenhirInterpreter.T T_GOBACK) -> "GOBACK" + | MenhirInterpreter.X (MenhirInterpreter.T T_GO) -> "GO" + | MenhirInterpreter.X (MenhirInterpreter.T T_GLOBAL) -> "GLOBAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_GIVING) -> "GIVING" + | MenhirInterpreter.X (MenhirInterpreter.T T_GET) -> "GET" + | MenhirInterpreter.X (MenhirInterpreter.T T_GENERATE) -> "GENERATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_GE) -> ">=" + | MenhirInterpreter.X (MenhirInterpreter.T T_GCOS) -> "GCOS" + | MenhirInterpreter.X (MenhirInterpreter.T T_FUNCTION_POINTER) -> "FUNCTION_POINTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_FUNCTION_ID) -> "FUNCTION_ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_FUNCTION) -> "FUNCTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_FULL_HEIGHT) -> "FULL_HEIGHT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FULL) -> "FULL" + | MenhirInterpreter.X (MenhirInterpreter.T T_FROM) -> "FROM" + | MenhirInterpreter.X (MenhirInterpreter.T T_FREE) -> "FREE" + | MenhirInterpreter.X (MenhirInterpreter.T T_FRAMED) -> "FRAMED" + | MenhirInterpreter.X (MenhirInterpreter.T T_FRAME) -> "FRAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_FORMAT) -> "FORMAT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FOREVER) -> "FOREVER" + | MenhirInterpreter.X (MenhirInterpreter.T T_FOREGROUND_COLOR) -> "FOREGROUND_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_FOR) -> "FOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_FOOTING) -> "FOOTING" + | MenhirInterpreter.X (MenhirInterpreter.T T_FONT) -> "FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLR) -> "FLR" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_SHORT) -> "FLOAT_SHORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_SIGNALING) -> "FLOAT_NOT_A_NUMBER_SIGNALING" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_QUIET) -> "FLOAT_NOT_A_NUMBER_QUIET" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER) -> "FLOAT_NOT_A_NUMBER" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_LONG) -> "FLOAT_LONG" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_INFINITY) -> "FLOAT_INFINITY" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_EXTENDED) -> "FLOAT_EXTENDED" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_DECIMAL_34) -> "FLOAT_DECIMAL_34" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_DECIMAL_16) -> "FLOAT_DECIMAL_16" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_DECIMAL) -> "FLOAT_DECIMAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_BINARY_64) -> "FLOAT_BINARY_64" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_BINARY_32) -> "FLOAT_BINARY_32" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_BINARY_128) -> "FLOAT_BINARY_128" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT_BINARY) -> "FLOAT_BINARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOATLIT) -> "FLOATLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOATING) -> "FLOATING" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLOAT) -> "FLOAT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLAT_BUTTONS) -> "FLAT_BUTTONS" + | MenhirInterpreter.X (MenhirInterpreter.T T_FLAT) -> "FLAT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FIXED_WIDTH) -> "FIXED_WIDTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_FIXED_FONT) -> "FIXED_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FIXEDLIT) -> "FIXEDLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FIXED) -> "FIXED" + | MenhirInterpreter.X (MenhirInterpreter.T T_FIRST) -> "FIRST" + | MenhirInterpreter.X (MenhirInterpreter.T T_FINISH_REASON) -> "FINISH_REASON" + | MenhirInterpreter.X (MenhirInterpreter.T T_FINALLY) -> "FINALLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_FINAL) -> "FINAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILL_PERCENT) -> "FILL_PERCENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILL_COLOR2) -> "FILL_COLOR2" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILL_COLOR) -> "FILL_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILLER) -> "FILLER" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE_POS) -> "FILE_POS" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE_NAME) -> "FILE_NAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE_LIMITS) -> "FILE_LIMITS" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE_LIMIT) -> "FILE_LIMIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE_ID) -> "FILE_ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE_CONTROL) -> "FILE_CONTROL" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILES) -> "FILES" + | MenhirInterpreter.X (MenhirInterpreter.T T_FILE) -> "FILE" + | MenhirInterpreter.X (MenhirInterpreter.T T_FH__KEYDEF) -> "FH__KEYDEF" + | MenhirInterpreter.X (MenhirInterpreter.T T_FH__FCD) -> "FH__FCD" + | MenhirInterpreter.X (MenhirInterpreter.T T_FD) -> "FD" + | MenhirInterpreter.X (MenhirInterpreter.T T_FARTHEST_FROM_ZERO) -> "FARTHEST_FROM_ZERO" + | MenhirInterpreter.X (MenhirInterpreter.T T_FALSE) -> "FALSE" + | MenhirInterpreter.X (MenhirInterpreter.T T_FACTORY) -> "FACTORY" + | MenhirInterpreter.X (MenhirInterpreter.T T_F) -> "F" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXTERNAL_FORM) -> "EXTERNAL_FORM" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXTERNAL) -> "EXTERNAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXTERN) -> "EXTERN" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXTENDED_SEARCH) -> "EXTENDED_SEARCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXTEND) -> "EXTEND" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXPANDS) -> "EXPANDS" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXPAND) -> "EXPAND" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXIT) -> "EXIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXHIBIT) -> "EXHIBIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXCLUSIVE_OR) -> "EXCLUSIVE_OR" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXCLUSIVE) -> "EXCLUSIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXCEPTION_VALUE) -> "EXCEPTION_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXCEPTION_OBJECT) -> "EXCEPTION_OBJECT" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXCEPTION) -> "EXCEPTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_EXAMINE) -> "EXAMINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_EVERY) -> "EVERY" + | MenhirInterpreter.X (MenhirInterpreter.T T_EVENT_LIST) -> "EVENT_LIST" + | MenhirInterpreter.X (MenhirInterpreter.T T_EVENT) -> "EVENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_EVALUATE) -> "EVALUATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ESI) -> "ESI" + | MenhirInterpreter.X (MenhirInterpreter.T T_ESCAPE_BUTTON) -> "ESCAPE_BUTTON" + | MenhirInterpreter.X (MenhirInterpreter.T T_ESCAPE) -> "ESCAPE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ERROR) -> "ERROR" + | MenhirInterpreter.X (MenhirInterpreter.T T_ERASE) -> "ERASE" + | MenhirInterpreter.X (MenhirInterpreter.T T_EQUAL) -> "EQUAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_EQ) -> "=" + | MenhirInterpreter.X (MenhirInterpreter.T T_EOS) -> "EOS" + | MenhirInterpreter.X (MenhirInterpreter.T T_EOP) -> "EOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_EOL) -> "EOL" + | MenhirInterpreter.X (MenhirInterpreter.T T_EOF) -> "EOF" + | MenhirInterpreter.X (MenhirInterpreter.T T_EO) -> "EO" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENVIRONMENT_VALUE) -> "ENVIRONMENT_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENVIRONMENT_NAME) -> "ENVIRONMENT_NAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENVIRONMENT) -> "ENVIRONMENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENTRY_REASON) -> "ENTRY_REASON" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENTRY_FIELD) -> "ENTRY_FIELD" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENTRY_CONVENTION) -> "ENTRY_CONVENTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENTRY) -> "ENTRY" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENTER) -> "ENTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENSURE_VISIBLE) -> "ENSURE_VISIBLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENGRAVED) -> "ENGRAVED" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_XML) -> "END_XML" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_WRITE) -> "END_WRITE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_UNSTRING) -> "END_UNSTRING" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_SUBTRACT) -> "END_SUBTRACT" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_STRING) -> "END_STRING" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_START) -> "END_START" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_SEND) -> "END_SEND" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_SEARCH) -> "END_SEARCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_REWRITE) -> "END_REWRITE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_RETURN) -> "END_RETURN" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_RECEIVE) -> "END_RECEIVE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_READ) -> "END_READ" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_PERFORM) -> "END_PERFORM" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_OF_PAGE) -> "END_OF_PAGE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_MULTIPLY) -> "END_MULTIPLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_MODIFY) -> "END_MODIFY" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_JSON) -> "END_JSON" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_IF) -> "END_IF" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_EVALUATE) -> "END_EVALUATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_DIVIDE) -> "END_DIVIDE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_DISPLAY) -> "END_DISPLAY" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_DELETE) -> "END_DELETE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_COMPUTE) -> "END_COMPUTE" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_COLOR) -> "END_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_CHAIN) -> "END_CHAIN" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_CALL) -> "END_CALL" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_ADD) -> "END_ADD" + | MenhirInterpreter.X (MenhirInterpreter.T T_END_ACCEPT) -> "END_ACCEPT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENDING) -> "ENDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_END) -> "END" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENCRYPTION) -> "ENCRYPTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENCODING) -> "ENCODING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ENABLE) -> "ENABLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_EMI) -> "EMI" + | MenhirInterpreter.X (MenhirInterpreter.T T_ELSE) -> "ELSE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ELEMENT) -> "ELEMENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_EIGHTY_EIGHT) -> "EIGHTY_EIGHT" + | MenhirInterpreter.X (MenhirInterpreter.T T_EGI) -> "EGI" + | MenhirInterpreter.X (MenhirInterpreter.T T_EDITING) -> "EDITING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ECHO) -> "ECHO" + | MenhirInterpreter.X (MenhirInterpreter.T T_EC) -> "EC" + | MenhirInterpreter.X (MenhirInterpreter.T T_EBCDIC) -> "EBCDIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_DYNAMIC) -> "DYNAMIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_DUPLICATES) -> "DUPLICATES" + | MenhirInterpreter.X (MenhirInterpreter.T T_DROP_LIST) -> "DROP_LIST" + | MenhirInterpreter.X (MenhirInterpreter.T T_DROP_DOWN) -> "DROP_DOWN" + | MenhirInterpreter.X (MenhirInterpreter.T T_DRAG_COLOR) -> "DRAG_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_DOWN) -> "DOWN" + | MenhirInterpreter.X (MenhirInterpreter.T T_DOUBLE_COLON) -> "::" + | MenhirInterpreter.X (MenhirInterpreter.T T_DOUBLE_ASTERISK) -> "**" + | MenhirInterpreter.X (MenhirInterpreter.T T_DOUBLE) -> "DOUBLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_DOTTED) -> "DOTTED" + | MenhirInterpreter.X (MenhirInterpreter.T T_DOTDASH) -> "DOTDASH" + | MenhirInterpreter.X (MenhirInterpreter.T T_DIVISION) -> "DIVISION" + | MenhirInterpreter.X (MenhirInterpreter.T T_DIVIDER_COLOR) -> "DIVIDER_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_DIVIDERS) -> "DIVIDERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_DIVIDE) -> "DIVIDE" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY_FORMAT) -> "DISPLAY_FORMAT" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY_COLUMNS) -> "DISPLAY_COLUMNS" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY_4) -> "DISPLAY_4" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY_3) -> "DISPLAY_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY_2) -> "DISPLAY_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY_1) -> "DISPLAY_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISPLAY) -> "DISPLAY" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISP) -> "DISP" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISK) -> "DISK" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISCONNECT) -> "DISCONNECT" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISC) -> "DISC" + | MenhirInterpreter.X (MenhirInterpreter.T T_DISABLE) -> "DISABLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_DIGITS) -> "DIGITS" + | MenhirInterpreter.X (MenhirInterpreter.T T_DETAIL) -> "DETAIL" + | MenhirInterpreter.X (MenhirInterpreter.T T_DESTROY) -> "DESTROY" + | MenhirInterpreter.X (MenhirInterpreter.T T_DESTINATION) -> "DESTINATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_DESCENDING) -> "DESCENDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEPENDING) -> "DEPENDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_DELIMITER) -> "DELIMITER" + | MenhirInterpreter.X (MenhirInterpreter.T T_DELIMITED) -> "DELIMITED" + | MenhirInterpreter.X (MenhirInterpreter.T T_DELETE) -> "DELETE" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEFINITION) -> "DEFINITION" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEFAULT_FONT) -> "DEFAULT_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEFAULT_BUTTON) -> "DEFAULT_BUTTON" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEFAULT) -> "DEFAULT" + | MenhirInterpreter.X (MenhirInterpreter.T T_DECLARATIVES) -> "DECLARATIVES" + | MenhirInterpreter.X (MenhirInterpreter.T T_DECIMAL_POINT) -> "DECIMAL_POINT" + | MenhirInterpreter.X (MenhirInterpreter.T T_DECIMAL_ENCODING) -> "DECIMAL_ENCODING" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_SUB_3) -> "DEBUG_SUB_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_SUB_2) -> "DEBUG_SUB_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_SUB_1) -> "DEBUG_SUB_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_NAME) -> "DEBUG_NAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_LINE) -> "DEBUG_LINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_ITEM) -> "DEBUG_ITEM" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUG_CONTENTS) -> "DEBUG_CONTENTS" + | MenhirInterpreter.X (MenhirInterpreter.T T_DEBUGGING) -> "DEBUGGING" + | MenhirInterpreter.X (MenhirInterpreter.T T_DAY_OF_WEEK) -> "DAY_OF_WEEK" + | MenhirInterpreter.X (MenhirInterpreter.T T_DAY) -> "DAY" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATE_WRITTEN) -> "DATE_WRITTEN" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATE_MODIFIED) -> "DATE_MODIFIED" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATE_ENTRY) -> "DATE_ENTRY" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATE_COMPILED) -> "DATE_COMPILED" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATE) -> "DATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATA_TYPES) -> "DATA_TYPES" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATA_RECORDS) -> "DATA_RECORDS" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATA_RECORD) -> "DATA_RECORD" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATA_POINTER) -> "DATA_POINTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATA_COLUMNS) -> "DATA_COLUMNS" + | MenhirInterpreter.X (MenhirInterpreter.T T_DATA) -> "DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_DASH_SIGN) -> "-" + | MenhirInterpreter.X (MenhirInterpreter.T T_DASHED) -> "DASHED" + | MenhirInterpreter.X (MenhirInterpreter.T T_CYL_OVERFLOW) -> "CYL_OVERFLOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_CYL_INDEX) -> "CYL_INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_CYCLE) -> "CYCLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CUSTOM_PRINT_TEMPLATE) -> "CUSTOM_PRINT_TEMPLATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR_Y) -> "CURSOR_Y" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR_X) -> "CURSOR_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR_ROW) -> "CURSOR_ROW" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR_FRAME_WIDTH) -> "CURSOR_FRAME_WIDTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR_COLOR) -> "CURSOR_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR_COL) -> "CURSOR_COL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURSOR) -> "CURSOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURRENT) -> "CURRENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_CURRENCY) -> "CURRENCY" + | MenhirInterpreter.X (MenhirInterpreter.T T_CS_GENERAL) -> "CS_GENERAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CS_BASIC) -> "CS_BASIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_CSIZE) -> "CSIZE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CRT_UNDER) -> "CRT_UNDER" + | MenhirInterpreter.X (MenhirInterpreter.T T_CRT) -> "CRT" + | MenhirInterpreter.X (MenhirInterpreter.T T_COUNT) -> "COUNT" + | MenhirInterpreter.X (MenhirInterpreter.T T_CORRESPONDING) -> "CORRESPONDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_CORE_INDEX) -> "CORE_INDEX" + | MenhirInterpreter.X (MenhirInterpreter.T T_COPY_SELECTION) -> "COPY_SELECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_COPY) -> "COPY" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONVERTING) -> "CONVERTING" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONVERSION) -> "CONVERSION" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONTROLS) -> "CONTROLS" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONTROL) -> "CONTROL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONTINUE) -> "CONTINUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONTENT) -> "CONTENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONTAINS) -> "CONTAINS" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONSTANT) -> "CONSTANT" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONSOLE_3) -> "CONSOLE_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONSOLE_2) -> "CONSOLE_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONSOLE_1) -> "CONSOLE_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONSOLE_0) -> "CONSOLE_0" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONNECT) -> "CONNECT" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONFIGURATION) -> "CONFIGURATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_CONDITION) -> "CONDITION" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_X) -> "COMP_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_N) -> "COMP_N" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_9) -> "COMP_9" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_7) -> "COMP_7" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_6) -> "COMP_6" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_5) -> "COMP_5" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_4) -> "COMP_4" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_3) -> "COMP_3" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_2) -> "COMP_2" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_15) -> "COMP_15" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_14) -> "COMP_14" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_13) -> "COMP_13" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_12) -> "COMP_12" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_11) -> "COMP_11" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_10) -> "COMP_10" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_1) -> "COMP_1" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP_0) -> "COMP_0" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPUTE) -> "COMPUTE" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPUTATIONAL_7) -> "COMPUTATIONAL_7" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPUTATIONAL_14) -> "COMPUTATIONAL_14" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPUTATIONAL_13) -> "COMPUTATIONAL_13" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPUTATIONAL_12) -> "COMPUTATIONAL_12" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPUTATIONAL_11) -> "COMPUTATIONAL_11" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPLEMENTARY) -> "COMPLEMENTARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMPLE) -> "COMPLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMP) -> "COMP" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMMUNICATION) -> "COMMUNICATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMMON) -> "COMMON" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMMIT) -> "COMMIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMMAND_LINE) -> "COMMAND_LINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMMA) -> "COMMA" + | MenhirInterpreter.X (MenhirInterpreter.T T_COMBO_BOX) -> "COMBO_BOX" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMN_PROTECTION) -> "COLUMN_PROTECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMN_HEADINGS) -> "COLUMN_HEADINGS" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMN_FONT) -> "COLUMN_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMN_DIVIDERS) -> "COLUMN_DIVIDERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMN_COLOR) -> "COLUMN_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMNS) -> "COLUMNS" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLUMN) -> "COLUMN" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLORS) -> "COLORS" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLOR) -> "COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLON) -> ":" + | MenhirInterpreter.X (MenhirInterpreter.T T_COLLATING) -> "COLLATING" + | MenhirInterpreter.X (MenhirInterpreter.T T_COL) -> "COL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CODE_SET) -> "CODE_SET" + | MenhirInterpreter.X (MenhirInterpreter.T T_CODE) -> "CODE" + | MenhirInterpreter.X (MenhirInterpreter.T T_COBOL) -> "COBOL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLOSE) -> "CLOSE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLOCK_UNITS) -> "CLOCK_UNITS" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLINES) -> "CLINES" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLINE) -> "CLINE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLEAR_SELECTION) -> "CLEAR_SELECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLASS_ID) -> "CLASS_ID" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLASSIFICATION) -> "CLASSIFICATION" + | MenhirInterpreter.X (MenhirInterpreter.T T_CLASS) -> "CLASS" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHECK_BOX) -> "CHECK_BOX" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHECKPOINT_FILE) -> "CHECKPOINT_FILE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHECK) -> "CHECK" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHARACTERS) -> "CHARACTERS" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHARACTER) -> "CHARACTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHANGED) -> "CHANGED" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHAINING) -> "CHAINING" + | MenhirInterpreter.X (MenhirInterpreter.T T_CHAIN) -> "CHAIN" + | MenhirInterpreter.X (MenhirInterpreter.T T_CH) -> "CH" + | MenhirInterpreter.X (MenhirInterpreter.T T_CF) -> "CF" + | MenhirInterpreter.X (MenhirInterpreter.T T_CENTURY_DATE) -> "CENTURY_DATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CENTERED_HEADINGS) -> "CENTERED_HEADINGS" + | MenhirInterpreter.X (MenhirInterpreter.T T_CENTERED) -> "CENTERED" + | MenhirInterpreter.X (MenhirInterpreter.T T_CENTER) -> "CENTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_CELL_PROTECTION) -> "CELL_PROTECTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_CELL_FONT) -> "CELL_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_CELL_DATA) -> "CELL_DATA" + | MenhirInterpreter.X (MenhirInterpreter.T T_CELL_COLOR) -> "CELL_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_CELL) -> "CELL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CD) -> "CD" + | MenhirInterpreter.X (MenhirInterpreter.T T_CCOL) -> "CCOL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CATALOGUE_NAME) -> "CATALOGUE_NAME" + | MenhirInterpreter.X (MenhirInterpreter.T T_CATALOGUED) -> "CATALOGUED" + | MenhirInterpreter.X (MenhirInterpreter.T T_CASSETTE) -> "CASSETTE" + | MenhirInterpreter.X (MenhirInterpreter.T T_CARD_READER) -> "CARD_READER" + | MenhirInterpreter.X (MenhirInterpreter.T T_CARD_PUNCH) -> "CARD_PUNCH" + | MenhirInterpreter.X (MenhirInterpreter.T T_CAPACITY) -> "CAPACITY" + | MenhirInterpreter.X (MenhirInterpreter.T T_CANCEL_BUTTON) -> "CANCEL_BUTTON" + | MenhirInterpreter.X (MenhirInterpreter.T T_CANCEL) -> "CANCEL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CALL) -> "CALL" + | MenhirInterpreter.X (MenhirInterpreter.T T_CALENDAR_FONT) -> "CALENDAR_FONT" + | MenhirInterpreter.X (MenhirInterpreter.T T_C) -> "C" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_XOR) -> "B_XOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_SHIFT_RC) -> "B_SHIFT_RC" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_SHIFT_R) -> "B_SHIFT_R" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_SHIFT_LC) -> "B_SHIFT_LC" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_SHIFT_L) -> "B_SHIFT_L" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_OR) -> "B_OR" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_NOT) -> "B_NOT" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_EXOR) -> "B_EXOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_B_AND) -> "B_AND" + | MenhirInterpreter.X (MenhirInterpreter.T T_BYTE_LENGTH) -> "BYTE_LENGTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_BYTES) -> "BYTES" + | MenhirInterpreter.X (MenhirInterpreter.T T_BYTE) -> "BYTE" + | MenhirInterpreter.X (MenhirInterpreter.T T_BY) -> "BY" + | MenhirInterpreter.X (MenhirInterpreter.T T_BUTTONS) -> "BUTTONS" + | MenhirInterpreter.X (MenhirInterpreter.T T_BUSY) -> "BUSY" + | MenhirInterpreter.X (MenhirInterpreter.T T_BULK_ADDITION) -> "BULK_ADDITION" + | MenhirInterpreter.X (MenhirInterpreter.T T_BSN) -> "BSN" + | MenhirInterpreter.X (MenhirInterpreter.T T_BOXED) -> "BOXED" + | MenhirInterpreter.X (MenhirInterpreter.T T_BOX) -> "BOX" + | MenhirInterpreter.X (MenhirInterpreter.T T_BOTTOM) -> "BOTTOM" + | MenhirInterpreter.X (MenhirInterpreter.T T_BOOLIT) -> "BOOLIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_BOOLEAN) -> "BOOLEAN" + | MenhirInterpreter.X (MenhirInterpreter.T T_BLOCK) -> "BLOCK" + | MenhirInterpreter.X (MenhirInterpreter.T T_BLINK) -> "BLINK" + | MenhirInterpreter.X (MenhirInterpreter.T T_BLANK) -> "BLANK" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITS) -> "BITS" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_WIDTH) -> "BITMAP_WIDTH" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_TRANSPARENT_COLOR) -> "BITMAP_TRANSPARENT_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_TRAILING) -> "BITMAP_TRAILING" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_TIMER) -> "BITMAP_TIMER" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_START) -> "BITMAP_START" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_NUMBER) -> "BITMAP_NUMBER" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_HANDLE) -> "BITMAP_HANDLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP_END) -> "BITMAP_END" + | MenhirInterpreter.X (MenhirInterpreter.T T_BITMAP) -> "BITMAP" + | MenhirInterpreter.X (MenhirInterpreter.T T_BIT) -> "BIT" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_SHORT) -> "BINARY_SHORT" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_SEQUENTIAL) -> "BINARY_SEQUENTIAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_LONG) -> "BINARY_LONG" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_ENCODING) -> "BINARY_ENCODING" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_DOUBLE) -> "BINARY_DOUBLE" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_C_LONG) -> "BINARY_C_LONG" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY_CHAR) -> "BINARY_CHAR" + | MenhirInterpreter.X (MenhirInterpreter.T T_BINARY) -> "BINARY" + | MenhirInterpreter.X (MenhirInterpreter.T T_BELL) -> "BELL" + | MenhirInterpreter.X (MenhirInterpreter.T T_BEGINNING) -> "BEGINNING" + | MenhirInterpreter.X (MenhirInterpreter.T T_BEFORE) -> "BEFORE" + | MenhirInterpreter.X (MenhirInterpreter.T T_BECOMES) -> "BECOMES" + | MenhirInterpreter.X (MenhirInterpreter.T T_BASED) -> "BASED" + | MenhirInterpreter.X (MenhirInterpreter.T T_BAR) -> "BAR" + | MenhirInterpreter.X (MenhirInterpreter.T T_BACKWARD) -> "BACKWARD" + | MenhirInterpreter.X (MenhirInterpreter.T T_BACKGROUND_STANDARD) -> "BACKGROUND_STANDARD" + | MenhirInterpreter.X (MenhirInterpreter.T T_BACKGROUND_LOW) -> "BACKGROUND_LOW" + | MenhirInterpreter.X (MenhirInterpreter.T T_BACKGROUND_HIGH) -> "BACKGROUND_HIGH" + | MenhirInterpreter.X (MenhirInterpreter.T T_BACKGROUND_COLOR) -> "BACKGROUND_COLOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_AWAY_FROM_ZERO) -> "AWAY_FROM_ZERO" + | MenhirInterpreter.X (MenhirInterpreter.T T_AUTO_SPIN) -> "AUTO_SPIN" + | MenhirInterpreter.X (MenhirInterpreter.T T_AUTO_DECIMAL) -> "AUTO_DECIMAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_AUTOMATIC) -> "AUTOMATIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_AUTO) -> "AUTO" + | MenhirInterpreter.X (MenhirInterpreter.T T_AUTHOR) -> "AUTHOR" + | MenhirInterpreter.X (MenhirInterpreter.T T_AT_EOP) -> "AT_EOP" + | MenhirInterpreter.X (MenhirInterpreter.T T_AT_END) -> "AT_END" + | MenhirInterpreter.X (MenhirInterpreter.T T_ATTRIBUTES) -> "ATTRIBUTES" + | MenhirInterpreter.X (MenhirInterpreter.T T_ATTRIBUTE) -> "ATTRIBUTE" + | MenhirInterpreter.X (MenhirInterpreter.T T_AT) -> "AT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ASTERISK) -> "*" + | MenhirInterpreter.X (MenhirInterpreter.T T_ASSIGN) -> "ASSIGN" + | MenhirInterpreter.X (MenhirInterpreter.T T_ASCII) -> "ASCII" + | MenhirInterpreter.X (MenhirInterpreter.T T_ASCENDING) -> "ASCENDING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ASA) -> "ASA" + | MenhirInterpreter.X (MenhirInterpreter.T T_AS) -> "AS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ARITHMETIC) -> "ARITHMETIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_ARGUMENT_VALUE) -> "ARGUMENT_VALUE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ARGUMENT_NUMBER) -> "ARGUMENT_NUMBER" + | MenhirInterpreter.X (MenhirInterpreter.T T_AREAS) -> "AREAS" + | MenhirInterpreter.X (MenhirInterpreter.T T_AREA) -> "AREA" + | MenhirInterpreter.X (MenhirInterpreter.T T_ARE) -> "ARE" + | MenhirInterpreter.X (MenhirInterpreter.T T_APPLY) -> "APPLY" + | MenhirInterpreter.X (MenhirInterpreter.T T_ANYCASE) -> "ANYCASE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ANY) -> "ANY" + | MenhirInterpreter.X (MenhirInterpreter.T T_ANUM) -> "ANUM" + | MenhirInterpreter.X (MenhirInterpreter.T T_ANSI) -> "ANSI" + | MenhirInterpreter.X (MenhirInterpreter.T T_AND) -> "AND" + | MenhirInterpreter.X (MenhirInterpreter.T T_AMPERSAND) -> "&" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALTERNATE) -> "ALTERNATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALTERING) -> "ALTERING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALTER) -> "ALTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALSO) -> "ALSO" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHANUM_PREFIX) -> "ALPHANUM_PREFIX" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHANUMERIC_EDITED) -> "ALPHANUMERIC_EDITED" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHANUMERIC) -> "ALPHANUMERIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHANUM) -> "ALPHANUM" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHABETIC_UPPER) -> "ALPHABETIC_UPPER" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHABETIC_LOWER) -> "ALPHABETIC_LOWER" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHABETIC) -> "ALPHABETIC" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALPHABET) -> "ALPHABET" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALLOWING) -> "ALLOWING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALLOCATE) -> "ALLOCATE" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALL) -> "ALL" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALIGNMENT) -> "ALIGNMENT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALIGNED) -> "ALIGNED" + | MenhirInterpreter.X (MenhirInterpreter.T T_ALIAS) -> "ALIAS" + | MenhirInterpreter.X (MenhirInterpreter.T T_AFTER) -> "AFTER" + | MenhirInterpreter.X (MenhirInterpreter.T T_ADVANCING) -> "ADVANCING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ADJUSTABLE_COLUMNS) -> "ADJUSTABLE_COLUMNS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ADDRESS) -> "ADDRESS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ADD) -> "ADD" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACTUAL) -> "ACTUAL" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACTIVE_X) -> "ACTIVE_X" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACTIVE_CLASS) -> "ACTIVE_CLASS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACTIVATING) -> "ACTIVATING" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACTION) -> "ACTION" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACCESS) -> "ACCESS" + | MenhirInterpreter.X (MenhirInterpreter.T T_ACCEPT) -> "ACCEPT" + | MenhirInterpreter.X (MenhirInterpreter.T T_ABSENT) -> "ABSENT" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_write_target) -> "write_target" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_write_statement) -> "write_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_working_storage_section) -> "working_storage_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_word_or_terminal) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_test) -> "with_test" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_status) -> "with_status" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_no_advancing) -> "with_no_advancing" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_lock_clause) -> "with_lock_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_lock) -> "with_lock" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_key) -> "with_key" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_with_data) -> "with_data" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_when_selection_objects) -> "when_selection_objects" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_when_phrase) -> "when_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_when_other) -> "when_other" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_when_clause) -> "when_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_varying_phrase) -> "varying_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_varying_clause) -> "varying_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_value_of_clause) -> "value_of_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_validation_stage) -> "validation_stage" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_validation_clause) -> "validation_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_validate_status_clause) -> "validate_status_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_validate_statement) -> "validate_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_using_clause) -> "using_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_using_by) -> "using_by" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_use_statement) -> "use_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_use_after_exception) -> "use_after_exception" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_usage_clause) -> "usage_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_usage) -> "usage" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_upon) -> "upon" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_up_down) -> "up_down" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_unstring_target) -> "unstring_target" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_unstring_statement) -> "unstring_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_unstring_delimiters) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_unlock_statement) -> "unlock_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_unconditional_action) -> "unconditional_action" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_typedef_clause) -> "typedef_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_transform_statement) -> "transform_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_then_replacing) -> "then_replacing" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_terminate_statement) -> "terminate_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_tallying_for) -> "tallying_for" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_tallying) -> "tallying" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_synchronized_clause) -> "synchronized_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_symbolic_characters_clause) -> "symbolic_characters_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_suppress_statement) -> "suppress_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sum_phrase) -> "sum_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sum_operands) -> "sum_operands" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sum_clause) -> "sum_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_subtract_statement) -> "subtract_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_subscripts) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_subscript_following) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_subscript_first) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_structure_kind) -> "structure_kind" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_string_statement) -> "string_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_string_or_int_literal) -> "string_or_int_literal" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_string_literal_no_all) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_string_literal) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_stop_statement) -> "stop_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_stop_kind) -> "stop_kind" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_step_phrase) -> "step_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_status_switch) -> "status_switch" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_start_statement) -> "start_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_standalone_condition) -> "standalone_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_specifier) -> "specifier" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_special_names_paragraph) -> "special_names_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_special_names_clause) -> "special_names_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_source_string) -> "source_string" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_source_operands) -> "source_operands" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_source_destination_clauses) -> "source_destination_clauses" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_source_destination_clause) -> "source_destination_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_source_computer_paragraph) -> "source_computer_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_source_clause) -> "source_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sort_statement) -> "sort_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sort_merge_file_descr_clause) -> "sort_merge_file_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_signedness_) -> "signedness_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sign_condition_no_zero) -> "sign_condition_no_zero" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sign_condition) -> "sign_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sign_clause) -> "sign_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sign) -> "sign" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sharing_phrase) -> "sharing_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sharing_mode) -> "sharing_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sharing_clause) -> "sharing_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_set_statement) -> "set_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_set_attribute_switches) -> "set_attribute_switches" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_sentence) -> "sentence" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_send_statement) -> "send_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_selection_subjects) -> "selection_subjects" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_selection_subject) -> "selection_subject" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_selection_objects) -> "selection_objects" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_selection_object) -> "selection_object" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_select_when_clause) -> "select_when_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_select_clause) -> "select_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_select) -> "select" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_segment_limit_clause) -> "segment_limit_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_section_paragraphs) -> "section_paragraphs" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_section_paragraph) -> "section_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_search_statement) -> "search_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_search_condition) -> "search_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_section) -> "screen_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_occurs_clause) -> "screen_occurs_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_line_column_clause) -> "screen_line_column_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_line_clause) -> "screen_line_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_descr_entry) -> "screen_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_descr_clause) -> "screen_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_column_clause) -> "screen_column_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_on_off) -> "screen_attribute_on_off" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_name) -> "screen_attribute_name" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_clauses) -> "screen_attribute_clauses" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_clause) -> "screen_attribute_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_same_as_clause) -> "same_as_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_same_area_clause) -> "same_area_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_s_delimited_by) -> "s_delimited_by" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rounding_mode) -> "rounding_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rounded_phrase_opt) -> "rounded_phrase_opt" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rounded_phrase) -> "rounded_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rounded_ident) -> "rounded_ident" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rounded_clause) -> "rounded_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_working_storage_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_with_test_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_with_status_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_step_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_special_names_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_source_computer_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_signedness_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_sign_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_sharing_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_screen_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_s_delimited_by_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_returning_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_retry_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_repository_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_report_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_read_direction_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_raising_exception_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_procedure_division_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_picture_locale_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_option_TO__name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_86_qualname__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_44_property_kind__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_43_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_38_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_37_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_34_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_33_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_32_qualname_or_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_30_qualname_or_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_14_string_literal__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_101_ident__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_100_ident__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_VARYING_ident__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_USING_name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_TO_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_string_or_int_literal__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_qualified_procedure_name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_procedure_name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_REMAINDER_ident__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_POSITION_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_ON_name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_INTO_loc_ident___) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_INTO_ident__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_IN_name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_integer__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_ident_or_literal__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_expression__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_BY_ident_or_numeric__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_BY_expression__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_pf_AS_string_literal__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_perform_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_options_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_object_reference_kind_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_object_procedure_division_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_object_computer_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_name_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_lock_or_retry_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_locale_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_local_storage_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_loc_upon__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_loc_program_procedure_division__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_loc_procedure_division__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_loc_environment_division__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_loc_entry_name_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_loc_data_division__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_linkage_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_io_control_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_integer_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_instance_definition_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_input_output_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_identification_division_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_file_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_file_control_paragraph_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_expression_no_all_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_expands_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_endianness_mode_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_depending_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_configuration_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_communication_section_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_collating_sequence_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_close_format_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_capacity_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ro_advancing_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnell_rev_tallying_) -> "rnell_rev_tallying_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_91_) -> "rnell_rev___anonymous_91_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_90_) -> "rnell_rev___anonymous_90_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_89_) -> "rnell_rev___anonymous_89_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_88_) -> "rnell_rev___anonymous_88_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_when_selection_objects_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_validation_stage_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_use_after_exception_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_unstring_target_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_subscript_following_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_specifier_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_screen_attribute_on_off_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_rounded_ident_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_qualname_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_qualified_procedure_name_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_pf_ALSO_string_or_int_literal__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_open_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_on_key_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_name_or_alphanum_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_name_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_using_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_using_by__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_tallying_for__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_special_names_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_sentence__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_select_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_section_paragraph__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_replacing_phrase__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_options_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_decl_section_paragraph__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_through_literal_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_line_position_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_integer_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_string_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_numeric_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_literal_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_by_after_before_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_file_with_opt_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_debug_target_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_column_position_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rnel_argument_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_select_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_pf_FILE_name__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_name_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_result_imperative_statement__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_sort_merge_file_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_sentence__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_section_paragraph__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_screen_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_same_area_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_rerun_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_group_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_descr_entry__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_object_computer_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_multiple_file_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_method_definition__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_file_or_sort_merge_descr_entry__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_file_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_entry_name_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_data_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_screen_descr_entry__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_report_group_descr_entry__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_data_descr_entry__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_communication_descr_entry__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_loc_communication_descr_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_key_is_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rl_inspect_where_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rewrite_statement) -> "rewrite_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_reversed_or_no_rewind_opt) -> "reversed_or_no_rewind_opt" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_returning) -> "returning" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_return_statement) -> "return_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_retry_phrase) -> "retry_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_resume_statement) -> "resume_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_reserve_clause) -> "reserve_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rerun_frequency) -> "rerun_frequency" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_rerun_clause) -> "rerun_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_repository_paragraph) -> "repository_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_value_clause) -> "report_value_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_type_clause) -> "report_type_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_section) -> "report_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_screen_usage_clause) -> "report_screen_usage_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_occurs_clause) -> "report_occurs_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_line_clause) -> "report_line_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_group_descr_entry) -> "report_group_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_group_descr_clause) -> "report_group_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_descr_entry) -> "report_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_descr_clause) -> "report_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_data_name_or_final) -> "report_data_name_or_final" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_column_clause) -> "report_column_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_report_clause) -> "report_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_replacing_phrase) -> "replacing_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_relop) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_release_statement) -> "release_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_relative_key_clause) -> "relative_key_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_relation_condition) -> "relation_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_redefines_clause) -> "redefines_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_record_key_clause) -> "record_key_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_record_delimiter_clause) -> "record_delimiter_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_record_delimiter) -> "record_delimiter" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_record_clause) -> "record_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_receive_statement) -> "receive_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_read_statement) -> "read_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_read_direction) -> "read_direction" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_range_expression) -> "range_expression" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_raising_phrase) -> "raising_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_raising_exception) -> "raising_exception" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_raise_statement) -> "raise_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualnames) -> "qualnames" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualname_or_literal) -> "qualname_or_literal" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualname_or_integer) -> "qualname_or_integer" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualname_or_alphanum) -> "qualname_or_alphanum" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualname) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualified_procedure_name) -> "qualified_procedure_name" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualident_refmod) -> "qualident_refmod" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualident_no_refmod) -> "qualident_no_refmod" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_qualident) -> "<(qualified) identifier>" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_purge_statement) -> "purge_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_property_clause) -> "property_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_prototype_id_paragraph) -> "program_prototype_id_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_prototype) -> "program_prototype" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_procedure_division) -> "program_procedure_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_kind) -> "program_kind" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_id_paragraph) -> "program_id_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_definition_no_end) -> "program_definition_no_end" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_definition) -> "program_definition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_program_collating_sequence_clause) -> "program_collating_sequence_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_procedure_name_decl) -> "procedure_name_decl" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_procedure_name) -> "procedure_name" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_procedure_division) -> "procedure_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_present_when_clause) -> "present_when_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_position) -> "position" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_plus_or_minus) -> "plus_or_minus" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_picture_locale_phrase) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_picture_clause) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_perform_statement) -> "perform_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_perform_phrase) -> "perform_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_partial_expression) -> "partial_expression" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_page_line_col) -> "page_line_col" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_page_limit_clause) -> "page_limit_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_padding_character_clause) -> "padding_character_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_output_or_giving) -> "output_or_giving" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_organization_clause) -> "organization_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_organization) -> "organization" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_order_table_clause) -> "order_table_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_options_paragraph) -> "options_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_options_clause) -> "options_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_optional_arguments_list) -> "optional_arguments_list" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_working_storage_section_) -> "option_working_storage_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_with_test_) -> "option_with_test_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_with_status_) -> "option_with_status_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_step_phrase_) -> "option_step_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_special_names_paragraph_) -> "option_special_names_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_source_computer_paragraph_) -> "option_source_computer_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_signedness_) -> "option_signedness_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_sign_) -> "option_sign_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_sharing_phrase_) -> "option_sharing_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_screen_section_) -> "option_screen_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_s_delimited_by_) -> "option_s_delimited_by_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_returning_) -> "option_returning_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_retry_phrase_) -> "option_retry_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_repository_paragraph_) -> "option_repository_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_report_section_) -> "option_report_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_read_direction_) -> "option_read_direction_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_raising_exception_) -> "option_raising_exception_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_procedure_division_) -> "option_procedure_division_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_picture_locale_phrase_) -> "option_picture_locale_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_option_TO__name__) -> "option_pf_option_TO__name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_option_IS__name__) -> "option_pf_option_IS__name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_86_qualname__) -> "option_pf___anonymous_86_qualname__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_44_property_kind__) -> "option_pf___anonymous_44_property_kind__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_43_integer__) -> "option_pf___anonymous_43_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_38_integer__) -> "option_pf___anonymous_38_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_37_integer__) -> "option_pf___anonymous_37_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_34_integer__) -> "option_pf___anonymous_34_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_33_integer__) -> "option_pf___anonymous_33_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_32_qualname_or_integer__) -> "option_pf___anonymous_32_qualname_or_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_30_qualname_or_integer__) -> "option_pf___anonymous_30_qualname_or_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_14_string_literal__) -> "option_pf___anonymous_14_string_literal__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_101_ident__) -> "option_pf___anonymous_101_ident__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_100_ident__) -> "option_pf___anonymous_100_ident__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_VARYING_ident__) -> "option_pf_VARYING_ident__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_USING_name__) -> "option_pf_USING_name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_TO_integer__) -> "option_pf_TO_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_string_or_int_literal__) -> "option_pf_THROUGH_string_or_int_literal__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_qualified_procedure_name__) -> "option_pf_THROUGH_qualified_procedure_name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_procedure_name__) -> "option_pf_THROUGH_procedure_name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_REMAINDER_ident__) -> "option_pf_REMAINDER_ident__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_POSITION_integer__) -> "option_pf_POSITION_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_ON_name__) -> "option_pf_ON_name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_INTO_loc_ident___) -> "option_pf_INTO_loc_ident___" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_INTO_ident__) -> "option_pf_INTO_ident__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_IN_name__) -> "option_pf_IN_name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_integer__) -> "option_pf_FROM_integer__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_ident_or_literal__) -> "option_pf_FROM_ident_or_literal__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_expression__) -> "option_pf_FROM_expression__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_BY_ident_or_numeric__) -> "option_pf_BY_ident_or_numeric__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_BY_expression__) -> "option_pf_BY_expression__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_pf_AS_string_literal__) -> "option_pf_AS_string_literal__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_perform_phrase_) -> "option_perform_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_or__NUMBER_NUMBERS__) -> "option_or__NUMBER_NUMBERS__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_or__LINE_LINES__) -> "option_or__LINE_LINES__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_or__IS_ARE__) -> "option_or__IS_ARE__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_or__AREA_AREAS__) -> "option_or__AREA_AREAS__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_options_paragraph_) -> "option_options_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_object_reference_kind_) -> "option_object_reference_kind_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_object_procedure_division_) -> "option_object_procedure_division_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_object_computer_paragraph_) -> "option_object_computer_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_name_) -> "option_name_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_mr___anonymous_0__) -> "option_mr___anonymous_0__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_lock_or_retry_) -> "option_lock_or_retry_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_locale_phrase_) -> "option_locale_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_local_storage_section_) -> "option_local_storage_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_upon__) -> "option_loc_upon__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_program_procedure_division__) -> "option_loc_program_procedure_division__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_program_definition_no_end__) -> "option_loc_program_definition_no_end__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_procedure_division__) -> "option_loc_procedure_division__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_environment_division__) -> "option_loc_environment_division__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_entry_name_clause__) -> "option_loc_entry_name_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_data_division__) -> "option_loc_data_division__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_SECURITY__) -> "option_loc_SECURITY__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_INSTALLATION__) -> "option_loc_INSTALLATION__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_DATE_WRITTEN__) -> "option_loc_DATE_WRITTEN__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_DATE_COMPILED__) -> "option_loc_DATE_COMPILED__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_loc_AUTHOR__) -> "option_loc_AUTHOR__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_linkage_section_) -> "option_linkage_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_limit_is__) -> "option_limit_is__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_io_control_paragraph_) -> "option_io_control_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_io_control_entry_) -> "option_io_control_entry_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_integer_) -> "option_integer_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_instance_definition_) -> "option_instance_definition_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_input_output_section_) -> "option_input_output_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_identification_division_) -> "option_identification_division_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_file_section_) -> "option_file_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_file_control_paragraph_) -> "option_file_control_paragraph_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_expression_no_all_) -> "option_expression_no_all_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_expands_phrase_) -> "option_expands_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_endianness_mode_) -> "option_endianness_mode_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_depending_phrase_) -> "option_depending_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_default_section_) -> "option_default_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_default_display_clause_) -> "option_default_display_clause_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_default_accept_clause_) -> "option_default_accept_clause_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_control_division_) -> "option_control_division_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_configuration_section_) -> "option_configuration_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_communication_section_) -> "option_communication_section_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_collating_sequence_phrase_) -> "option_collating_sequence_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_close_format_) -> "option_close_format_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_capacity_phrase_) -> "option_capacity_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_call_using_by_) -> "option_call_using_by_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_advancing_phrase_) -> "option_advancing_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option__assign_external__) -> "option__assign_external__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_78_) -> "option___anonymous_78_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_74_) -> "option___anonymous_74_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_73_) -> "option___anonymous_73_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_59_) -> "option___anonymous_59_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_57_) -> "option___anonymous_57_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_39_) -> "option___anonymous_39_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_25_) -> "option___anonymous_25_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_24_) -> "option___anonymous_24_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_22_) -> "option___anonymous_22_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_1_) -> "option___anonymous_1_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_WITH_) -> "option_WITH_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_WHEN_) -> "option_WHEN_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_TO_) -> "option_TO_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_TIMES_) -> "option_TIMES_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_THEN_) -> "option_THEN_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_THAN_) -> "option_THAN_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_TERMINAL_) -> "option_TERMINAL_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_TAPE_) -> "option_TAPE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_SYMBOLIC_) -> "option_SYMBOLIC_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_STRUCTURE_) -> "option_STRUCTURE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_STATUS_) -> "option_STATUS_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_SIZE_) -> "option_SIZE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_SIGN_) -> "option_SIGN_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_SET_) -> "option_SET_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_RIGHT_) -> "option_RIGHT_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_REFERENCES_) -> "option_REFERENCES_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_RECORD_) -> "option_RECORD_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_PROGRAM_) -> "option_PROGRAM_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_PROCEDURE_) -> "option_PROCEDURE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_PRINTING_) -> "option_PRINTING_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_PERIOD_) -> "option_PERIOD_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_OTHER_) -> "option_OTHER_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_ORDER_) -> "option_ORDER_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_ON_) -> "option_ON_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_OF_) -> "option_OF_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_NUMBER_) -> "option_NUMBER_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_MODE_) -> "option_MODE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_MESSAGE_) -> "option_MESSAGE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_LINES_) -> "option_LINES_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_LINE_) -> "option_LINE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_LENGTH_) -> "option_LENGTH_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_LEFT_) -> "option_LEFT_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_KEY_) -> "option_KEY_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_IS_) -> "option_IS_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_INITIAL_) -> "option_INITIAL_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_INDICATE_) -> "option_INDICATE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_IN_) -> "option_IN_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_FROM_) -> "option_FROM_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_FOR_) -> "option_FOR_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_FILE_) -> "option_FILE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_EVERY_) -> "option_EVERY_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_END_) -> "option_END_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_DEFAULT_) -> "option_DEFAULT_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_DATA_) -> "option_DATA_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_CONTAINS_) -> "option_CONTAINS_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_COLLATING_) -> "option_COLLATING_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_CHARACTERS_) -> "option_CHARACTERS_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_CHARACTER_) -> "option_CHARACTER_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_BY_) -> "option_BY_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_AT_) -> "option_AT_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_AREA_) -> "option_AREA_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_ARE_) -> "option_ARE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_option_ADVANCING_) -> "option_ADVANCING_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_open_statement) -> "open_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_open_phrase) -> "open_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_open_mode) -> "open_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_on_overflow) -> "on_overflow" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_on_or_off) -> "on_or_off" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_on_key) -> "on_key" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_on_exception) -> "on_exception" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_occurs_fixed_clause) -> "occurs_fixed_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_occurs_dynamic_clause) -> "occurs_dynamic_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_occurs_depending_clause) -> "occurs_depending_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_view) -> "object_view" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_reference_kind) -> "object_reference_kind" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_ref) -> "object_ref" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_procedure_division) -> "object_procedure_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_paragraph) -> "object_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_computer_paragraph) -> "object_computer_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_object_computer_clause) -> "object_computer_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_numeric_literal) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ntl_name_) -> "ntl_name_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ntl_arithmetic_term_) -> "ntl_arithmetic_term_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nonrel_condition) -> "nonrel_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nonnumeric_literal_no_all) -> "nonnumeric_literal_no_all" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nonnumeric_literal) -> "nonnumeric_literal" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_next_group_clause) -> "next_group_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nell_rev_when_phrase_) -> "nell_rev_when_phrase_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nell_rev_source_string_) -> "nell_rev_source_string_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nell_rev_name_) -> "nell_rev_name_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nell_rev_loc_result_imperative_statement__) -> "nell_rev_loc_result_imperative_statement__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nell_rev_loc_when_clause__) -> "nell_rev_loc_when_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nell_rev___anonymous_70_) -> "nell_rev___anonymous_70_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_when_selection_objects_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_validation_stage_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_use_after_exception_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_unstring_target_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_sum_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_subscript_following_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_specifier_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_screen_attribute_on_off_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_rounded_ident_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_qualname_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_qualified_procedure_name_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_pf_ALSO_string_or_int_literal__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_open_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_on_key_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_name_or_alphanum_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_name_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_using_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_using_by__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_tallying_for__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_special_names_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_source_destination_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_sentence__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_select_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_section_paragraph__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_screen_attribute_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_replacing_phrase__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_options_clause__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc_decl_section_paragraph__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_loc___anonymous_72__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_literal_through_literal_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_literal_phrase_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_literal_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_line_position_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_integer_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_string_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_numeric_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_literal_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_ident_by_after_before_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_ident_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_file_with_opt_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_debug_target_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_column_position_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel_argument_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_84_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_80_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_50_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_48_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_42_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_29_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_21_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_16_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_13_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_names_or_open_mode) -> "names_or_open_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_names) -> "names" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_name_or_string) -> "name_or_string" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_name_or_alphanum) -> "name_or_alphanum" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_name) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_multiply_statement) -> "multiply_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_multiple_file_clause) -> "multiple_file_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_move_statement) -> "move_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_mnemonic_name_suffix) -> "mnemonic_name_suffix" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_mnemonic_name_clause) -> "mnemonic_name_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_85_) -> "midrule___anonymous_85_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_77_) -> "midrule___anonymous_77_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_on_overflow_NOT_ON_OVERFLOW__) -> "midrule___anonymous_76_on_overflow_NOT_ON_OVERFLOW__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_on_exception_NOT_ON_EXCEPTION__) -> "midrule___anonymous_76_on_exception_NOT_ON_EXCEPTION__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_at_eop_NOT_AT_EOP__) -> "midrule___anonymous_76_at_eop_NOT_AT_EOP__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_at_end_NOT_AT_END__) -> "midrule___anonymous_76_at_end_NOT_AT_END__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_ON_SIZE_ERROR_NOT_ON_SIZE_ERROR__) -> "midrule___anonymous_76_ON_SIZE_ERROR_NOT_ON_SIZE_ERROR__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_INVALID_KEY_NOT_INVALID_KEY__) -> "midrule___anonymous_76_INVALID_KEY_NOT_INVALID_KEY__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_68_) -> "midrule___anonymous_68_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_67_) -> "midrule___anonymous_67_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_66_) -> "midrule___anonymous_66_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_65_) -> "midrule___anonymous_65_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_64_) -> "midrule___anonymous_64_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_62_) -> "midrule___anonymous_62_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_61_) -> "midrule___anonymous_61_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_58_) -> "midrule___anonymous_58_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_55_) -> "midrule___anonymous_55_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_54_) -> "midrule___anonymous_54_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_53_) -> "midrule___anonymous_53_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_52_) -> "midrule___anonymous_52_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_51_) -> "midrule___anonymous_51_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_40_) -> "midrule___anonymous_40_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_35_) -> "midrule___anonymous_35_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_28_) -> "midrule___anonymous_28_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_27_) -> "midrule___anonymous_27_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_15_) -> "midrule___anonymous_15_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_0_) -> "midrule___anonymous_0_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_method_id_paragraph) -> "method_id_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_method_definition) -> "method_definition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_message_or_segment) -> "message_or_segment" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_merge_statement) -> "merge_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_memory_size_unit) -> "memory_size_unit" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_memory_size_clause) -> "memory_size_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_mcs_kind) -> "mcs_kind" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_mcs_command) -> "mcs_command" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_sf_rnel_loc_options_clause___PERIOD__) -> "loption_sf_rnel_loc_options_clause___PERIOD__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_26_nel_name___) -> "loption_pf___anonymous_26_nel_name___" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_20_names__) -> "loption_pf___anonymous_20_names__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_17_names__) -> "loption_pf___anonymous_17_names__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_pf_USING_rnel_loc_using_by____) -> "loption_pf_USING_rnel_loc_using_by____" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_pf_UPON_names__) -> "loption_pf_UPON_names__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_pf_ON_rnel_validation_stage___) -> "loption_pf_ON_rnel_validation_stage___" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_indexed_by_) -> "loption_indexed_by_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption_declaratives_) -> "loption_declaratives_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_9_) -> "loption___anonymous_9_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_8_) -> "loption___anonymous_8_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_7_) -> "loption___anonymous_7_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_6_) -> "loption___anonymous_6_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_5_) -> "loption___anonymous_5_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_49_) -> "loption___anonymous_49_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_4_) -> "loption___anonymous_4_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_lock_or_retry) -> "lock_or_retry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_lock_mode_clause) -> "lock_mode_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_lock_mode) -> "lock_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_locale_value_or_ident) -> "locale_value_or_ident" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_locale_phrase) -> "locale_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_locale_or_default) -> "locale_or_default" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_locale_or_ambiguous) -> "locale_or_ambiguous" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_locale_clause) -> "locale_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_locale_category) -> "locale_category" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_local_storage_section) -> "local_storage_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ll_rev_loc_compilation_unit__) -> "ll_rev_loc_compilation_unit__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ll_rev_and_clause_) -> "ll_rev_and_clause_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_literal_through_literal) -> "literal_through_literal" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_literal_phrase) -> "literal_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_literal_int_ident) -> "literal_int_ident" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_literal) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_select_) -> "list_select_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_pf_FILE_name__) -> "list_pf_FILE_name__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_name_) -> "list_name_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_result_imperative_statement__) -> "list_loc_result_imperative_statement__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_sort_merge_file_descr_clause__) -> "list_loc_sort_merge_file_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_sentence__) -> "list_loc_sentence__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_section_paragraph__) -> "list_loc_section_paragraph__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_screen_descr_clause__) -> "list_loc_screen_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_same_area_clause__) -> "list_loc_same_area_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_rerun_clause__) -> "list_loc_rerun_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_group_descr_clause__) -> "list_loc_report_group_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_descr_entry__) -> "list_loc_report_descr_entry__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_descr_clause__) -> "list_loc_report_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_program_definition__) -> "list_loc_program_definition__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_object_computer_clause__) -> "list_loc_object_computer_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_multiple_file_clause__) -> "list_loc_multiple_file_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_method_definition__) -> "list_loc_method_definition__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_file_or_sort_merge_descr_entry__) -> "list_loc_file_or_sort_merge_descr_entry__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_file_descr_clause__) -> "list_loc_file_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_entry_name_clause__) -> "list_loc_entry_name_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_data_descr_clause__) -> "list_loc_data_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_screen_descr_entry__) -> "list_loc_constant_or_screen_descr_entry__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_report_group_descr_entry__) -> "list_loc_constant_or_report_group_descr_entry__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_data_descr_entry__) -> "list_loc_constant_or_data_descr_entry__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_communication_descr_entry__) -> "list_loc_communication_descr_entry__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_loc_communication_descr_clause__) -> "list_loc_communication_descr_clause__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_key_is_) -> "list_key_is_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_list_inspect_where_) -> "list_inspect_where_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_linkage_section) -> "linkage_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_line_position) -> "line_position" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_line_number) -> "line_number" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_line_header) -> "line_header" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_linage_header) -> "linage_header" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_linage_clause) -> "linage_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_lc_all_or_default) -> "lc_all_or_default" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_label_clause) -> "label_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_l_pf_AFTER_loc_varying_phrase___) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_l_loc___anonymous_79__) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_l___anonymous_99_) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_key_is) -> "key_is" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_justified_clause) -> "justified_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_io_control_paragraph) -> "io_control_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_io_control_entry) -> "io_control_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_invoke_statement) -> "invoke_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_invalid_when_clause) -> "invalid_when_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_intrinsic_function_name) -> "intrinsic_function_name" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_intermediate_rounding_clause) -> "intermediate_rounding_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_interface_specifier) -> "interface_specifier" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_interface_id_paragraph) -> "interface_id_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_interface_definition) -> "interface_definition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_integers) -> "integers" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_integer) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_instance_definition) -> "instance_definition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_inspect_where) -> "inspect_where" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_inspect_statement) -> "inspect_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_inspect_spec) -> "inspect_spec" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_input_output_section) -> "input_output_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_input_or_using) -> "input_or_using" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_inline_invocation) -> "inline_invocation" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_initiate_statement) -> "initiate_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_initialize_statement) -> "initialize_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_init_data_category) -> "init_data_category" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_informational_paragraphs) -> "informational_paragraphs" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_indexed_by) -> "indexed_by" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_in_of) -> "in_of" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_imperative_statement) -> "imperative_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_imp_stmts) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_if_statement_explicit_term) -> "if_statement_explicit_term" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_if_statement) -> "if_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_if_body) -> "if_body" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_idents) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_identification_division) -> "identification_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_string_no_all) -> "ident_or_string_no_all" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_string) -> "ident_or_string" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_numeric) -> "ident_or_numeric" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_nonnumeric_no_all) -> "ident_or_nonnumeric_no_all" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_nonnumeric) -> "ident_or_nonnumeric" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_nested) -> "ident_or_nested" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_literal) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_integer) -> "ident_or_integer" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_or_alphanum) -> "ident_or_alphanum" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_by_after_before) -> "ident_by_after_before" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_after_before_list) -> "ident_after_before_list" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident_after_before) -> "ident_after_before" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ident) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_group_usage_clause) -> "group_usage_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_group_indicate_clause) -> "group_indicate_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_goback_statement) -> "goback_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_go_to_statement) -> "go_to_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_global_clause) -> "global_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_generate_statement) -> "generate_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_function_unit) -> "function_unit" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_function_specifier) -> "function_specifier" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_function_name) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_function_ident) -> "function_ident" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_function_id_paragraph) -> "function_id_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_from_to_characters_opt) -> "from_to_characters_opt" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_free_statement) -> "free_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_format_clause) -> "format_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_for_alphanumeric_or_national_opt) -> "for_alphanumeric_or_national_opt" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_floatlit) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_float_decimal_clause) -> "float_decimal_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_float_content) -> "float_content" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_float_binary_clause) -> "float_binary_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_flat_combination_operand) -> "flat_combination_operand" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_fixedlit) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_file_with_opt) -> "file_with_opt" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_file_status_clause) -> "file_status_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_file_section) -> "file_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_file_or_sort_merge_descr_entry) -> "file_or_sort_merge_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_file_descr_clause) -> "file_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_file_control_paragraph) -> "file_control_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_figurative_constant) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_factory_paragraph) -> "factory_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_factory_definition) -> "factory_definition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_external_clause) -> "external_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_extended_condition) -> "extended_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expression_par_unop) -> "expression_par_unop" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expression_no_all) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expression) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_unary) -> "expr_unary" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_term_par_unop) -> "expr_term_par_unop" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_term_no_all) -> "expr_term_no_all" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_term) -> "expr_term" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_factor_par_unop) -> "expr_factor_par_unop" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_factor_no_all) -> "expr_factor_no_all" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expr_factor) -> "expr_factor" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_expands_phrase) -> "expands_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_exit_statement) -> "exit_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_exit_spec) -> "exit_spec" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_evaluate_statement) -> "evaluate_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_error_or_no_error) -> "error_or_no_error" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_erase_clause) -> "erase_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_environment_division) -> "environment_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_entry_name_clause) -> "entry_name_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_entry_convention_clause) -> "entry_convention_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_enter_statement) -> "enter_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_ending_indicator) -> "ending_indicator" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_endianness_mode_) -> "endianness_mode_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_endianness_mode) -> "endianness_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_subtract) -> "end_subtract" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_search) -> "end_search" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_multiply) -> "end_multiply" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_divide) -> "end_divide" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_display) -> "end_display" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_add) -> "end_add" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_end_accept) -> "end_accept" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_encoding_mode) -> "encoding_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_encoding_endianness_opt) -> "encoding_endianness_opt" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_encoding_endianness) -> "encoding_endianness" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_enable_statement) -> "enable_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_else_phrase) -> "else_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_elementary_string_or_int_literal) -> "elementary_string_or_int_literal" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_elementary_nonnumeric_literal) -> "elementary_nonnumeric_literal" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_dynamic_length_structure_clause) -> "dynamic_length_structure_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_dynamic_length_clause) -> "dynamic_length_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_divide_statement) -> "divide_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_display_statement) -> "display_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_disable_statement) -> "disable_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_destination_clause) -> "destination_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_depending_phrase) -> "depending_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_delete_statement) -> "delete_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_default_section_clauses) -> "default_section_clauses" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_default_section) -> "default_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_default_display_clause) -> "default_display_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_default_clause) -> "default_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_default_accept_clause) -> "default_accept_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_declaratives) -> "declaratives" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_decl_section_paragraph) -> "decl_section_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_decimal_point_clause) -> "decimal_point_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_debug_target) -> "debug_target" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_date_day_time) -> "date_day_time" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_value_clause) -> "data_value_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_type_clause) -> "data_type_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_occurs_clause) -> "data_occurs_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_division) -> "data_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_descr_entry) -> "data_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_descr_clause) -> "data_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_data_clause) -> "data_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_cursor_clause) -> "cursor_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_currency_sign_clause) -> "currency_sign_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_cs_national) -> "cs_national" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_cs_alphanumeric) -> "cs_alphanumeric" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_crt_status_clause) -> "crt_status_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_counter) -> "counter" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_control_division) -> "control_division" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_control_clause) -> "control_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_continue_statement) -> "continue_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_value_length) -> "constant_value_length" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_value) -> "constant_value" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_record_clause) -> "constant_record_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_or_screen_descr_entry) -> "constant_or_screen_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_or_report_group_descr_entry) -> "constant_or_report_group_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_or_data_descr_entry) -> "constant_or_data_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant_level) -> "constant_level" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_constant) -> "constant" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_configuration_section) -> "configuration_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_condition) -> "condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_compute_statement) -> "compute_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_complex_condition) -> "complex_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_compilation_unit) -> "compilation_unit" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_compilation_group) -> "compilation_group" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_communication_section) -> "communication_section" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_communication_descr_entry) -> "communication_descr_entry" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_communication_descr_clause) -> "communication_descr_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_column_position) -> "column_position" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_column_number) -> "column_number" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_column_header) -> "column_header" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_collating_sequence_phrase) -> "collating_sequence_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_collating_sequence_clause) -> "collating_sequence_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_code_set_clause) -> "code_set_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_code_clause) -> "code_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_close_statement) -> "close_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_close_format) -> "close_format" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_specifier) -> "class_specifier" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_name_clause) -> "class_name_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_id_paragraph) -> "class_id_paragraph" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_definition) -> "class_definition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_condition_no_ident) -> "class_condition_no_ident" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_condition) -> "class_condition" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_clause) -> "class_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_class_) -> "class_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_character_set) -> "character_set" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_character_classification_clause) -> "character_classification_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_character_classification) -> "character_classification" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_cc_national) -> "cc_national" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_cc_alphanumeric) -> "cc_alphanumeric" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_category_to_value) -> "category_to_value" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_capacity_phrase) -> "capacity_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_cancel_statement) -> "cancel_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_call_using_by) -> "call_using_by" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_call_statement) -> "call_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_call_prefix) -> "call_prefix" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_or__RECORD_RECORDS__) -> "boption_or__RECORD_RECORDS__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_or__LINE_LINES__) -> "boption_or__LINE_LINES__" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_identification_division_) -> "boption_identification_division_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_87_) -> "boption___anonymous_87_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_81_) -> "boption___anonymous_81_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_71_) -> "boption___anonymous_71_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_60_) -> "boption___anonymous_60_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_56_) -> "boption___anonymous_56_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_47_) -> "boption___anonymous_47_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_46_) -> "boption___anonymous_46_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_45_) -> "boption___anonymous_45_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_41_) -> "boption___anonymous_41_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_3_) -> "boption___anonymous_3_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_18_) -> "boption___anonymous_18_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_12_) -> "boption___anonymous_12_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_11_) -> "boption___anonymous_11_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_102_) -> "boption___anonymous_102_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_10_) -> "boption___anonymous_10_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_YYYYMMDD_) -> "boption_YYYYMMDD_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_YYYYDDD_) -> "boption_YYYYDDD_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_STRONG_) -> "boption_STRONG_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_SIGNED_) -> "boption_SIGNED_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_SHORT_) -> "boption_SHORT_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_OVERRIDE_) -> "boption_OVERRIDE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_OPTIONAL_) -> "boption_OPTIONAL_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_ONLY_) -> "boption_ONLY_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_NOT_) -> "boption_NOT_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_MULTIPLE_) -> "boption_MULTIPLE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_IN_ARITHMETIC_RANGE_) -> "boption_IN_ARITHMETIC_RANGE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_INITIALIZED_) -> "boption_INITIALIZED_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_INITIAL_) -> "boption_INITIAL_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_GLOBAL_) -> "boption_GLOBAL_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_CYCLE_) -> "boption_CYCLE_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boption_ALL_) -> "boption_ALL_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_boollit) -> "boollit" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_block_contains_clause) -> "block_contains_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_blank_when_zero_clause) -> "blank_when_zero_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_blank_clause) -> "blank_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_based_clause) -> "based_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_atomic_expression_no_all) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_atomic_expression) -> "" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_at_eop) -> "at_eop" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_at_end) -> "at_end" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_assign_clause) -> "assign_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_as__strlit_) -> "as__strlit_" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_arithmetic_term_no_all) -> "arithmetic_term_no_all" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_arithmetic_term) -> "arithmetic_term" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_arithmetic_mode) -> "arithmetic_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_arithmetic_clause) -> "arithmetic_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_argument) -> "argument" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_area_source) -> "area_source" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_any_length_clause) -> "any_length_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_and_clause) -> "and_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_alternate_record_key_clause) -> "alternate_record_key_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_alter_statement) -> "alter_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_alphabet_specification) -> "alphabet_specification" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_alphabet_name_clause) -> "alphabet_name_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_allocate_statement) -> "allocate_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_alignment) -> "alignment" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_aligned_clause) -> "aligned_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_after_or_before) -> "after_or_before" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_advancing_phrase) -> "advancing_phrase" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_address) -> "address" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_add_statement) -> "add_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_access_mode_clause) -> "access_mode_clause" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_access_mode) -> "access_mode" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N_accept_statement) -> "accept_statement" + | MenhirInterpreter.X (MenhirInterpreter.N MenhirInterpreter.N__assign_external_) -> "_assign_external_" + +let print_value (type a) : a MenhirInterpreter.symbol -> a -> string = function + | MenhirInterpreter.T T_error -> (fun _ -> "error") + | MenhirInterpreter.T T_ZERO_FILL -> (fun _ -> "ZERO_FILL") + | MenhirInterpreter.T T_ZERO -> (fun _ -> "ZERO") + | MenhirInterpreter.T T_YYYYMMDD -> (fun _ -> "YYYYMMDD") + | MenhirInterpreter.T T_YYYYDDD -> (fun _ -> "YYYYDDD") + | MenhirInterpreter.T T_Y -> (fun _ -> "Y") + | MenhirInterpreter.T T_XOR -> (fun _ -> "XOR") + | MenhirInterpreter.T T_XML_SCHEMA -> (fun _ -> "XML_SCHEMA") + | MenhirInterpreter.T T_XML_DECLARATION -> (fun _ -> "XML_DECLARATION") + | MenhirInterpreter.T T_XML -> (fun _ -> "XML") + | MenhirInterpreter.T T_X -> (fun _ -> "X") + | MenhirInterpreter.T T_WRITE_VERIFY -> (fun _ -> "WRITE_VERIFY") + | MenhirInterpreter.T T_WRITE_ONLY -> (fun _ -> "WRITE_ONLY") + | MenhirInterpreter.T T_WRITERS -> (fun _ -> "WRITERS") + | MenhirInterpreter.T T_WRITE -> (fun _ -> "WRITE") + | MenhirInterpreter.T T_WRAP -> (fun _ -> "WRAP") + | MenhirInterpreter.T T_WORKING_STORAGE -> (fun _ -> "WORKING_STORAGE") + | MenhirInterpreter.T T_WORD_IN_AREA_A -> (fun _ -> "WORD_IN_AREA_A") + | MenhirInterpreter.T T_WORDS -> (fun _ -> "WORDS") + | MenhirInterpreter.T T_WORD -> (fun _ -> "WORD") + | MenhirInterpreter.T T_WITH_DATA -> (fun _ -> "WITH_DATA") + | MenhirInterpreter.T T_WITH -> (fun _ -> "WITH") + | MenhirInterpreter.T T_WINDOW -> (fun _ -> "WINDOW") + | MenhirInterpreter.T T_WIDTH_IN_CELLS -> (fun _ -> "WIDTH_IN_CELLS") + | MenhirInterpreter.T T_WIDTH -> (fun _ -> "WIDTH") + | MenhirInterpreter.T T_WHEN -> (fun _ -> "WHEN") + | MenhirInterpreter.T T_WEB_BROWSER -> (fun _ -> "WEB_BROWSER") + | MenhirInterpreter.T T_WAIT -> (fun _ -> "WAIT") + | MenhirInterpreter.T T_VTOP -> (fun _ -> "VTOP") + | MenhirInterpreter.T T_VSCROLL_POS -> (fun _ -> "VSCROLL_POS") + | MenhirInterpreter.T T_VSCROLL_BAR -> (fun _ -> "VSCROLL_BAR") + | MenhirInterpreter.T T_VSCROLL -> (fun _ -> "VSCROLL") + | MenhirInterpreter.T T_VPADDING -> (fun _ -> "VPADDING") + | MenhirInterpreter.T T_VOLATILE -> (fun _ -> "VOLATILE") + | MenhirInterpreter.T T_VLR -> (fun _ -> "VLR") + | MenhirInterpreter.T T_VIRTUAL_WIDTH -> (fun _ -> "VIRTUAL_WIDTH") + | MenhirInterpreter.T T_VIRTUAL -> (fun _ -> "VIRTUAL") + | MenhirInterpreter.T T_VIA -> (fun _ -> "VIA") + | MenhirInterpreter.T T_VERY_HEAVY -> (fun _ -> "VERY_HEAVY") + | MenhirInterpreter.T T_VERTICAL -> (fun _ -> "VERTICAL") + | MenhirInterpreter.T T_VARYING -> (fun _ -> "VARYING") + | MenhirInterpreter.T T_VARIANT -> (fun _ -> "VARIANT") + | MenhirInterpreter.T T_VARIABLE -> (fun _ -> "VARIABLE") + | MenhirInterpreter.T T_VALUE_FORMAT -> (fun _ -> "VALUE_FORMAT") + | MenhirInterpreter.T T_VALUES -> (fun _ -> "VALUES") + | MenhirInterpreter.T T_VALUE -> (fun _ -> "VALUE") + | MenhirInterpreter.T T_VALIDATING -> (fun _ -> "VALIDATING") + | MenhirInterpreter.T T_VALIDATE_STATUS -> (fun _ -> "VALIDATE_STATUS") + | MenhirInterpreter.T T_VALIDATE -> (fun _ -> "VALIDATE") + | MenhirInterpreter.T T_VALID -> (fun _ -> "VALID") + | MenhirInterpreter.T T_V -> (fun _ -> "V") + | MenhirInterpreter.T T_UTF_8 -> (fun _ -> "UTF_8") + | MenhirInterpreter.T T_UTF_16 -> (fun _ -> "UTF_16") + | MenhirInterpreter.T T_USING -> (fun _ -> "USING") + | MenhirInterpreter.T T_USE_TAB -> (fun _ -> "USE_TAB") + | MenhirInterpreter.T T_USE_RETURN -> (fun _ -> "USE_RETURN") + | MenhirInterpreter.T T_USE_ALT -> (fun _ -> "USE_ALT") + | MenhirInterpreter.T T_USER_DEFAULT -> (fun _ -> "USER_DEFAULT") + | MenhirInterpreter.T T_USER -> (fun _ -> "USER") + | MenhirInterpreter.T T_USE -> (fun _ -> "USE") + | MenhirInterpreter.T T_USAGE -> (fun _ -> "USAGE") + | MenhirInterpreter.T T_UPPER -> (fun _ -> "UPPER") + | MenhirInterpreter.T T_UPON -> (fun _ -> "UPON") + | MenhirInterpreter.T T_UPDATERS -> (fun _ -> "UPDATERS") + | MenhirInterpreter.T T_UPDATE -> (fun _ -> "UPDATE") + | MenhirInterpreter.T T_UP -> (fun _ -> "UP") + | MenhirInterpreter.T T_UNUSED__ -> (fun _ -> "UNUSED__") + | MenhirInterpreter.T T_UNTIL -> (fun _ -> "UNTIL") + | MenhirInterpreter.T T_UNSTRING -> (fun _ -> "UNSTRING") + | MenhirInterpreter.T T_UNSORTED -> (fun _ -> "UNSORTED") + | MenhirInterpreter.T T_UNSIGNED_SHORT -> (fun _ -> "UNSIGNED_SHORT") + | MenhirInterpreter.T T_UNSIGNED_LONG -> (fun _ -> "UNSIGNED_LONG") + | MenhirInterpreter.T T_UNSIGNED_INT -> (fun _ -> "UNSIGNED_INT") + | MenhirInterpreter.T T_UNSIGNED -> (fun _ -> "UNSIGNED") + | MenhirInterpreter.T T_UNSEQUAL -> (fun _ -> "UNSEQUAL") + | MenhirInterpreter.T T_UNLOCK -> (fun _ -> "UNLOCK") + | MenhirInterpreter.T T_UNIVERSAL -> (fun _ -> "UNIVERSAL") + | MenhirInterpreter.T T_UNIT -> (fun _ -> "UNIT") + | MenhirInterpreter.T T_UNFRAMED -> (fun _ -> "UNFRAMED") + | MenhirInterpreter.T T_UNDERLINE -> (fun _ -> "UNDERLINE") + | MenhirInterpreter.T T_UNBOUNDED -> (fun _ -> "UNBOUNDED") + | MenhirInterpreter.T T_UFF -> (fun _ -> "UFF") + | MenhirInterpreter.T T_UCS_4 -> (fun _ -> "UCS_4") + | MenhirInterpreter.T T_U -> (fun _ -> "U") + | MenhirInterpreter.T T_TYPEDEF -> (fun _ -> "TYPEDEF") + | MenhirInterpreter.T T_TYPE -> (fun _ -> "TYPE") + | MenhirInterpreter.T T_TRUNCATION -> (fun _ -> "TRUNCATION") + | MenhirInterpreter.T T_TRUE -> (fun _ -> "TRUE") + | MenhirInterpreter.T T_TREE_VIEW -> (fun _ -> "TREE_VIEW") + | MenhirInterpreter.T T_TRANSPARENT -> (fun _ -> "TRANSPARENT") + | MenhirInterpreter.T T_TRANSFORM -> (fun _ -> "TRANSFORM") + | MenhirInterpreter.T T_TRAILING_SIGN -> (fun _ -> "TRAILING_SIGN") + | MenhirInterpreter.T T_TRAILING_SHIFT -> (fun _ -> "TRAILING_SHIFT") + | MenhirInterpreter.T T_TRAILING -> (fun _ -> "TRAILING") + | MenhirInterpreter.T T_TRADITIONAL_FONT -> (fun _ -> "TRADITIONAL_FONT") + | MenhirInterpreter.T T_TRACK_LIMIT -> (fun _ -> "TRACK_LIMIT") + | MenhirInterpreter.T T_TRACK_AREA -> (fun _ -> "TRACK_AREA") + | MenhirInterpreter.T T_TRACKS -> (fun _ -> "TRACKS") + | MenhirInterpreter.T T_TRACK -> (fun _ -> "TRACK") + | MenhirInterpreter.T T_TOWARD_LESSER -> (fun _ -> "TOWARD_LESSER") + | MenhirInterpreter.T T_TOWARD_GREATER -> (fun _ -> "TOWARD_GREATER") + | MenhirInterpreter.T T_TOP_LEVEL -> (fun _ -> "TOP_LEVEL") + | MenhirInterpreter.T T_TOP -> (fun _ -> "TOP") + | MenhirInterpreter.T T_TO -> (fun _ -> "TO") + | MenhirInterpreter.T T_TITLE_POSITION -> (fun _ -> "TITLE_POSITION") + | MenhirInterpreter.T T_TITLE -> (fun _ -> "TITLE") + | MenhirInterpreter.T T_TIME_OUT -> (fun _ -> "TIME_OUT") + | MenhirInterpreter.T T_TIMES -> (fun _ -> "TIMES") + | MenhirInterpreter.T T_TIME -> (fun _ -> "TIME") + | MenhirInterpreter.T T_TILED_HEADINGS -> (fun _ -> "TILED_HEADINGS") + | MenhirInterpreter.T T_THUMB_POSITION -> (fun _ -> "THUMB_POSITION") + | MenhirInterpreter.T T_THROUGH -> (fun _ -> "THROUGH") + | MenhirInterpreter.T T_THREEDIMENSIONAL -> (fun _ -> "THREEDIMENSIONAL") + | MenhirInterpreter.T T_THREADS -> (fun _ -> "THREADS") + | MenhirInterpreter.T T_THREAD -> (fun _ -> "THREAD") + | MenhirInterpreter.T T_THEN -> (fun _ -> "THEN") + | MenhirInterpreter.T T_THAN -> (fun _ -> "THAN") + | MenhirInterpreter.T T_TEXT -> (fun _ -> "TEXT") + | MenhirInterpreter.T T_TEST -> (fun _ -> "TEST") + | MenhirInterpreter.T T_TERMINATION_VALUE -> (fun _ -> "TERMINATION_VALUE") + | MenhirInterpreter.T T_TERMINATE -> (fun _ -> "TERMINATE") + | MenhirInterpreter.T T_TERMINAL_X -> (fun _ -> "TERMINAL_X") + | MenhirInterpreter.T T_TERMINAL_INFO -> (fun _ -> "TERMINAL_INFO") + | MenhirInterpreter.T T_TERMINAL_3 -> (fun _ -> "TERMINAL_3") + | MenhirInterpreter.T T_TERMINAL_2 -> (fun _ -> "TERMINAL_2") + | MenhirInterpreter.T T_TERMINAL_1 -> (fun _ -> "TERMINAL_1") + | MenhirInterpreter.T T_TERMINAL_0 -> (fun _ -> "TERMINAL_0") + | MenhirInterpreter.T T_TERMINAL -> (fun _ -> "TERMINAL") + | MenhirInterpreter.T T_TEMPORARY -> (fun _ -> "TEMPORARY") + | MenhirInterpreter.T T_TEMP -> (fun _ -> "TEMP") + | MenhirInterpreter.T T_TAPE -> (fun _ -> "TAPE") + | MenhirInterpreter.T T_TALLYING -> (fun _ -> "TALLYING") + | MenhirInterpreter.T T_TAB_TO_DELETE -> (fun _ -> "TAB_TO_DELETE") + | MenhirInterpreter.T T_TAB_TO_ADD -> (fun _ -> "TAB_TO_ADD") + | MenhirInterpreter.T T_TABLE -> (fun _ -> "TABLE") + | MenhirInterpreter.T T_TAB -> (fun _ -> "TAB") + | MenhirInterpreter.T T_SYSTEM_OFFSET -> (fun _ -> "SYSTEM_OFFSET") + | MenhirInterpreter.T T_SYSTEM_INFO -> (fun _ -> "SYSTEM_INFO") + | MenhirInterpreter.T T_SYSTEM_DEFAULT -> (fun _ -> "SYSTEM_DEFAULT") + | MenhirInterpreter.T T_SYSTEM -> (fun _ -> "SYSTEM") + | MenhirInterpreter.T T_SYSOUT_X -> (fun _ -> "SYSOUT_X") + | MenhirInterpreter.T T_SYSOUT_3 -> (fun _ -> "SYSOUT_3") + | MenhirInterpreter.T T_SYSOUT_2 -> (fun _ -> "SYSOUT_2") + | MenhirInterpreter.T T_SYSOUT_1 -> (fun _ -> "SYSOUT_1") + | MenhirInterpreter.T T_SYSOUT_0 -> (fun _ -> "SYSOUT_0") + | MenhirInterpreter.T T_SYSIN_X -> (fun _ -> "SYSIN_X") + | MenhirInterpreter.T T_SYSIN_3 -> (fun _ -> "SYSIN_3") + | MenhirInterpreter.T T_SYSIN_2 -> (fun _ -> "SYSIN_2") + | MenhirInterpreter.T T_SYSIN_1 -> (fun _ -> "SYSIN_1") + | MenhirInterpreter.T T_SYSIN_0 -> (fun _ -> "SYSIN_0") + | MenhirInterpreter.T T_SYNCHRONIZED -> (fun _ -> "SYNCHRONIZED") + | MenhirInterpreter.T T_SYMBOLIC -> (fun _ -> "SYMBOLIC") + | MenhirInterpreter.T T_SYMBOL -> (fun _ -> "SYMBOL") + | MenhirInterpreter.T T_SWITCH -> (fun _ -> "SWITCH") + | MenhirInterpreter.T T_SUPPRESS -> (fun _ -> "SUPPRESS") + | MenhirInterpreter.T T_SUPER -> (fun _ -> "SUPER") + | MenhirInterpreter.T T_SUM -> (fun _ -> "SUM") + | MenhirInterpreter.T T_SUB_SCHEMA -> (fun _ -> "SUB_SCHEMA") + | MenhirInterpreter.T T_SUB_QUEUE_3 -> (fun _ -> "SUB_QUEUE_3") + | MenhirInterpreter.T T_SUB_QUEUE_2 -> (fun _ -> "SUB_QUEUE_2") + | MenhirInterpreter.T T_SUB_QUEUE_1 -> (fun _ -> "SUB_QUEUE_1") + | MenhirInterpreter.T T_SUBWINDOW -> (fun _ -> "SUBWINDOW") + | MenhirInterpreter.T T_SUBTRACT -> (fun _ -> "SUBTRACT") + | MenhirInterpreter.T T_STYLE -> (fun _ -> "STYLE") + | MenhirInterpreter.T T_STRUCTURE -> (fun _ -> "STRUCTURE") + | MenhirInterpreter.T T_STRONG -> (fun _ -> "STRONG") + | MenhirInterpreter.T T_STRING -> (fun _ -> "STRING") + | MenhirInterpreter.T T_STOP -> (fun _ -> "STOP") + | MenhirInterpreter.T T_STEP -> (fun _ -> "STEP") + | MenhirInterpreter.T T_STDCALL -> (fun _ -> "STDCALL") + | MenhirInterpreter.T T_STATUS_TEXT -> (fun _ -> "STATUS_TEXT") + | MenhirInterpreter.T T_STATUS_BAR -> (fun _ -> "STATUS_BAR") + | MenhirInterpreter.T T_STATUS -> (fun _ -> "STATUS") + | MenhirInterpreter.T T_STATION -> (fun _ -> "STATION") + | MenhirInterpreter.T T_STATIC_LIST -> (fun _ -> "STATIC_LIST") + | MenhirInterpreter.T T_STATIC -> (fun _ -> "STATIC") + | MenhirInterpreter.T T_STATEMENT -> (fun _ -> "STATEMENT") + | MenhirInterpreter.T T_START_Y -> (fun _ -> "START_Y") + | MenhirInterpreter.T T_START_X -> (fun _ -> "START_X") + | MenhirInterpreter.T T_START -> (fun _ -> "START") + | MenhirInterpreter.T T_STANDARD_DECIMAL -> (fun _ -> "STANDARD_DECIMAL") + | MenhirInterpreter.T T_STANDARD_BINARY -> (fun _ -> "STANDARD_BINARY") + | MenhirInterpreter.T T_STANDARD_2 -> (fun _ -> "STANDARD_2") + | MenhirInterpreter.T T_STANDARD_1 -> (fun _ -> "STANDARD_1") + | MenhirInterpreter.T T_STANDARD -> (fun _ -> "STANDARD") + | MenhirInterpreter.T T_STACK -> (fun _ -> "STACK") + | MenhirInterpreter.T T_SSF -> (fun _ -> "SSF") + | MenhirInterpreter.T T_SQUARE -> (fun _ -> "SQUARE") + | MenhirInterpreter.T T_SPINNER -> (fun _ -> "SPINNER") + | MenhirInterpreter.T T_SPECIAL_NAMES -> (fun _ -> "SPECIAL_NAMES") + | MenhirInterpreter.T T_SPACE_FILL -> (fun _ -> "SPACE_FILL") + | MenhirInterpreter.T T_SPACE -> (fun _ -> "SPACE") + | MenhirInterpreter.T T_SOURCE_COMPUTER -> (fun _ -> "SOURCE_COMPUTER") + | MenhirInterpreter.T T_SOURCES -> (fun _ -> "SOURCES") + | MenhirInterpreter.T T_SOURCE -> (fun _ -> "SOURCE") + | MenhirInterpreter.T T_SORT_ORDER -> (fun _ -> "SORT_ORDER") + | MenhirInterpreter.T T_SORT_MERGE -> (fun _ -> "SORT_MERGE") + | MenhirInterpreter.T T_SORT -> (fun _ -> "SORT") + | MenhirInterpreter.T T_SMALL_FONT -> (fun _ -> "SMALL_FONT") + | MenhirInterpreter.T T_SLASH -> (fun _ -> "/") + | MenhirInterpreter.T T_SIZE -> (fun _ -> "SIZE") + | MenhirInterpreter.T T_SINTLIT -> (fun _ -> "SINTLIT") + | MenhirInterpreter.T T_SIGNED_SHORT -> (fun _ -> "SIGNED_SHORT") + | MenhirInterpreter.T T_SIGNED_LONG -> (fun _ -> "SIGNED_LONG") + | MenhirInterpreter.T T_SIGNED_INT -> (fun _ -> "SIGNED_INT") + | MenhirInterpreter.T T_SIGNED -> (fun _ -> "SIGNED") + | MenhirInterpreter.T T_SIGN -> (fun _ -> "SIGN") + | MenhirInterpreter.T T_SHOW_SEL_ALWAYS -> (fun _ -> "SHOW_SEL_ALWAYS") + | MenhirInterpreter.T T_SHOW_NONE -> (fun _ -> "SHOW_NONE") + | MenhirInterpreter.T T_SHOW_LINES -> (fun _ -> "SHOW_LINES") + | MenhirInterpreter.T T_SHORT_DATE -> (fun _ -> "SHORT_DATE") + | MenhirInterpreter.T T_SHORT -> (fun _ -> "SHORT") + | MenhirInterpreter.T T_SHARING -> (fun _ -> "SHARING") + | MenhirInterpreter.T T_SHADOW -> (fun _ -> "SHADOW") + | MenhirInterpreter.T T_SHADING -> (fun _ -> "SHADING") + | MenhirInterpreter.T T_SET -> (fun _ -> "SET") + | MenhirInterpreter.T T_SEQUENTIAL -> (fun _ -> "SEQUENTIAL") + | MenhirInterpreter.T T_SEQUENCE -> (fun _ -> "SEQUENCE") + | MenhirInterpreter.T T_SEPARATION -> (fun _ -> "SEPARATION") + | MenhirInterpreter.T T_SEPARATE -> (fun _ -> "SEPARATE") + | MenhirInterpreter.T T_SENTENCE -> (fun _ -> "SENTENCE") + | MenhirInterpreter.T T_SEND -> (fun _ -> "SEND") + | MenhirInterpreter.T T_SELF_ACT -> (fun _ -> "SELF_ACT") + | MenhirInterpreter.T T_SELF -> (fun _ -> "SELF") + | MenhirInterpreter.T T_SELECT_ALL -> (fun _ -> "SELECT_ALL") + | MenhirInterpreter.T T_SELECTION_TEXT -> (fun _ -> "SELECTION_TEXT") + | MenhirInterpreter.T T_SELECTION_INDEX -> (fun _ -> "SELECTION_INDEX") + | MenhirInterpreter.T T_SELECTION -> (fun _ -> "SELECTION") + | MenhirInterpreter.T T_SELECT -> (fun _ -> "SELECT") + | MenhirInterpreter.T T_SEGMENT_LIMIT -> (fun _ -> "SEGMENT_LIMIT") + | MenhirInterpreter.T T_SEGMENT -> (fun _ -> "SEGMENT") + | MenhirInterpreter.T T_SECURITY -> (fun _ -> "SECURITY") + | MenhirInterpreter.T T_SECURE -> (fun _ -> "SECURE") + | MenhirInterpreter.T T_SECTION -> (fun _ -> "SECTION") + | MenhirInterpreter.T T_SECONDS -> (fun _ -> "SECONDS") + | MenhirInterpreter.T T_SECONDARY -> (fun _ -> "SECONDARY") + | MenhirInterpreter.T T_SEARCH_TEXT -> (fun _ -> "SEARCH_TEXT") + | MenhirInterpreter.T T_SEARCH_OPTIONS -> (fun _ -> "SEARCH_OPTIONS") + | MenhirInterpreter.T T_SEARCH -> (fun _ -> "SEARCH") + | MenhirInterpreter.T T_SD -> (fun _ -> "SD") + | MenhirInterpreter.T T_SCROLL_BAR -> (fun _ -> "SCROLL_BAR") + | MenhirInterpreter.T T_SCROLL -> (fun _ -> "SCROLL") + | MenhirInterpreter.T T_SCREEN -> (fun _ -> "SCREEN") + | MenhirInterpreter.T T_SAVE_AS_NO_PROMPT -> (fun _ -> "SAVE_AS_NO_PROMPT") + | MenhirInterpreter.T T_SAVE_AS -> (fun _ -> "SAVE_AS") + | MenhirInterpreter.T T_SARF -> (fun _ -> "SARF") + | MenhirInterpreter.T T_SAME -> (fun _ -> "SAME") + | MenhirInterpreter.T T_S -> (fun _ -> "S") + | MenhirInterpreter.T T_RUN -> (fun _ -> "RUN") + | MenhirInterpreter.T T_RPAR -> (fun _ -> ")") + | MenhirInterpreter.T T_ROW_PROTECTION -> (fun _ -> "ROW_PROTECTION") + | MenhirInterpreter.T T_ROW_HEADINGS -> (fun _ -> "ROW_HEADINGS") + | MenhirInterpreter.T T_ROW_FONT -> (fun _ -> "ROW_FONT") + | MenhirInterpreter.T T_ROW_DIVIDERS -> (fun _ -> "ROW_DIVIDERS") + | MenhirInterpreter.T T_ROW_COLOR_PATTERN -> (fun _ -> "ROW_COLOR_PATTERN") + | MenhirInterpreter.T T_ROW_COLOR -> (fun _ -> "ROW_COLOR") + | MenhirInterpreter.T T_ROUNDING -> (fun _ -> "ROUNDING") + | MenhirInterpreter.T T_ROUNDED -> (fun _ -> "ROUNDED") + | MenhirInterpreter.T T_ROLLBACK -> (fun _ -> "ROLLBACK") + | MenhirInterpreter.T T_RIMMED -> (fun _ -> "RIMMED") + | MenhirInterpreter.T T_RIGHT_JUSTIFY -> (fun _ -> "RIGHT_JUSTIFY") + | MenhirInterpreter.T T_RIGHT_ALIGN -> (fun _ -> "RIGHT_ALIGN") + | MenhirInterpreter.T T_RIGHT -> (fun _ -> "RIGHT") + | MenhirInterpreter.T T_RH -> (fun _ -> "RH") + | MenhirInterpreter.T T_RF -> (fun _ -> "RF") + | MenhirInterpreter.T T_REWRITE -> (fun _ -> "REWRITE") + | MenhirInterpreter.T T_REWIND -> (fun _ -> "REWIND") + | MenhirInterpreter.T T_REVERSE_VIDEO -> (fun _ -> "REVERSE_VIDEO") + | MenhirInterpreter.T T_REVERSED -> (fun _ -> "REVERSED") + | MenhirInterpreter.T T_REVERSE -> (fun _ -> "REVERSE") + | MenhirInterpreter.T T_RETURNING -> (fun _ -> "RETURNING") + | MenhirInterpreter.T T_RETURN -> (fun _ -> "RETURN") + | MenhirInterpreter.T T_RETRY -> (fun _ -> "RETRY") + | MenhirInterpreter.T T_RETENTION -> (fun _ -> "RETENTION") + | MenhirInterpreter.T T_RESUME -> (fun _ -> "RESUME") + | MenhirInterpreter.T T_RESET_TABS -> (fun _ -> "RESET_TABS") + | MenhirInterpreter.T T_RESET_LIST -> (fun _ -> "RESET_LIST") + | MenhirInterpreter.T T_RESET_GRID -> (fun _ -> "RESET_GRID") + | MenhirInterpreter.T T_RESET -> (fun _ -> "RESET") + | MenhirInterpreter.T T_RESERVE -> (fun _ -> "RESERVE") + | MenhirInterpreter.T T_RERUN -> (fun _ -> "RERUN") + | MenhirInterpreter.T T_REREAD -> (fun _ -> "REREAD") + | MenhirInterpreter.T T_REQUIRED -> (fun _ -> "REQUIRED") + | MenhirInterpreter.T T_REPOSITORY -> (fun _ -> "REPOSITORY") + | MenhirInterpreter.T T_REPORTS -> (fun _ -> "REPORTS") + | MenhirInterpreter.T T_REPORTING -> (fun _ -> "REPORTING") + | MenhirInterpreter.T T_REPORT -> (fun _ -> "REPORT") + | MenhirInterpreter.T T_REPLACING -> (fun _ -> "REPLACING") + | MenhirInterpreter.T T_REPLACE -> (fun _ -> "REPLACE") + | MenhirInterpreter.T T_REPEATED -> (fun _ -> "REPEATED") + | MenhirInterpreter.T T_REORG_CRITERIA -> (fun _ -> "REORG_CRITERIA") + | MenhirInterpreter.T T_RENAMES -> (fun _ -> "RENAMES") + | MenhirInterpreter.T T_REMOVAL -> (fun _ -> "REMOVAL") + | MenhirInterpreter.T T_REMARKS -> (fun _ -> "REMARKS") + | MenhirInterpreter.T T_REMAINDER -> (fun _ -> "REMAINDER") + | MenhirInterpreter.T T_RELEASE -> (fun _ -> "RELEASE") + | MenhirInterpreter.T T_RELATIVE -> (fun _ -> "RELATIVE") + | MenhirInterpreter.T T_RELATION -> (fun _ -> "RELATION") + | MenhirInterpreter.T T_REGION_COLOR -> (fun _ -> "REGION_COLOR") + | MenhirInterpreter.T T_REFRESH -> (fun _ -> "REFRESH") + | MenhirInterpreter.T T_REFERENCES -> (fun _ -> "REFERENCES") + | MenhirInterpreter.T T_REFERENCE -> (fun _ -> "REFERENCE") + | MenhirInterpreter.T T_REEL -> (fun _ -> "REEL") + | MenhirInterpreter.T T_REDEFINES -> (fun _ -> "REDEFINES") + | MenhirInterpreter.T T_RECURSIVE -> (fun _ -> "RECURSIVE") + | MenhirInterpreter.T T_RECORD_TO_DELETE -> (fun _ -> "RECORD_TO_DELETE") + | MenhirInterpreter.T T_RECORD_TO_ADD -> (fun _ -> "RECORD_TO_ADD") + | MenhirInterpreter.T T_RECORD_OVERFLOW -> (fun _ -> "RECORD_OVERFLOW") + | MenhirInterpreter.T T_RECORD_DATA -> (fun _ -> "RECORD_DATA") + | MenhirInterpreter.T T_RECORDS -> (fun _ -> "RECORDS") + | MenhirInterpreter.T T_RECORDING -> (fun _ -> "RECORDING") + | MenhirInterpreter.T T_RECORD -> (fun _ -> "RECORD") + | MenhirInterpreter.T T_RECEIVED -> (fun _ -> "RECEIVED") + | MenhirInterpreter.T T_RECEIVE -> (fun _ -> "RECEIVE") + | MenhirInterpreter.T T_READ_ONLY -> (fun _ -> "READ_ONLY") + | MenhirInterpreter.T T_READERS -> (fun _ -> "READERS") + | MenhirInterpreter.T T_READ -> (fun _ -> "READ") + | MenhirInterpreter.T T_RD -> (fun _ -> "RD") + | MenhirInterpreter.T T_RANDOM -> (fun _ -> "RANDOM") + | MenhirInterpreter.T T_RAISING -> (fun _ -> "RAISING") + | MenhirInterpreter.T T_RAISED -> (fun _ -> "RAISED") + | MenhirInterpreter.T T_RAISE -> (fun _ -> "RAISE") + | MenhirInterpreter.T T_RADIO_BUTTON -> (fun _ -> "RADIO_BUTTON") + | MenhirInterpreter.T T_QUOTE -> (fun _ -> "QUOTE") + | MenhirInterpreter.T T_QUEUED -> (fun _ -> "QUEUED") + | MenhirInterpreter.T T_QUEUE -> (fun _ -> "QUEUE") + | MenhirInterpreter.T T_QUERY_INDEX -> (fun _ -> "QUERY_INDEX") + | MenhirInterpreter.T T_PUSH_BUTTON -> (fun _ -> "PUSH_BUTTON") + | MenhirInterpreter.T T_PURGE -> (fun _ -> "PURGE") + | MenhirInterpreter.T T_PROTOTYPE -> (fun _ -> "PROTOTYPE") + | MenhirInterpreter.T T_PROTECTED -> (fun _ -> "PROTECTED") + | MenhirInterpreter.T T_PROPERTY -> (fun _ -> "PROPERTY") + | MenhirInterpreter.T T_PROPERTIES -> (fun _ -> "PROPERTIES") + | MenhirInterpreter.T T_PROMPT -> (fun _ -> "PROMPT") + | MenhirInterpreter.T T_PROHIBITED -> (fun _ -> "PROHIBITED") + | MenhirInterpreter.T T_PROGRESS -> (fun _ -> "PROGRESS") + | MenhirInterpreter.T T_PROGRAM_POINTER -> (fun _ -> "PROGRAM_POINTER") + | MenhirInterpreter.T T_PROGRAM_ID -> (fun _ -> "PROGRAM_ID") + | MenhirInterpreter.T T_PROGRAM -> (fun _ -> "PROGRAM") + | MenhirInterpreter.T T_PROCESS_AREA -> (fun _ -> "PROCESS_AREA") + | MenhirInterpreter.T T_PROCESSING -> (fun _ -> "PROCESSING") + | MenhirInterpreter.T T_PROCEED -> (fun _ -> "PROCEED") + | MenhirInterpreter.T T_PROCEDURE_POINTER -> (fun _ -> "PROCEDURE_POINTER") + | MenhirInterpreter.T T_PROCEDURES -> (fun _ -> "PROCEDURES") + | MenhirInterpreter.T T_PROCEDURE -> (fun _ -> "PROCEDURE") + | MenhirInterpreter.T T_PRIORITY -> (fun _ -> "PRIORITY") + | MenhirInterpreter.T T_PRINT_PREVIEW -> (fun _ -> "PRINT_PREVIEW") + | MenhirInterpreter.T T_PRINT_NO_PROMPT -> (fun _ -> "PRINT_NO_PROMPT") + | MenhirInterpreter.T T_PRINTING -> (fun _ -> "PRINTING") + | MenhirInterpreter.T T_PRINTER_1 -> (fun _ -> "PRINTER_1") + | MenhirInterpreter.T T_PRINTER -> (fun _ -> "PRINTER") + | MenhirInterpreter.T T_PRINT -> (fun _ -> "PRINT") + | MenhirInterpreter.T T_PRIMARY -> (fun _ -> "PRIMARY") + | MenhirInterpreter.T T_PREVIOUS -> (fun _ -> "PREVIOUS") + | MenhirInterpreter.T T_PRESENT -> (fun _ -> "PRESENT") + | MenhirInterpreter.T T_PREFIXED -> (fun _ -> "PREFIXED") + | MenhirInterpreter.T T_POSITIVE -> (fun _ -> "POSITIVE") + | MenhirInterpreter.T T_POSITION_SHIFT -> (fun _ -> "POSITION_SHIFT") + | MenhirInterpreter.T T_POSITION -> (fun _ -> "POSITION") + | MenhirInterpreter.T T_POS -> (fun _ -> "POS") + | MenhirInterpreter.T T_POP_UP -> (fun _ -> "POP_UP") + | MenhirInterpreter.T T_POINTER -> (fun _ -> "POINTER") + | MenhirInterpreter.T T_PLUS_SIGN -> (fun _ -> "+") + | MenhirInterpreter.T T_PLUS -> (fun _ -> "PLUS") + | MenhirInterpreter.T T_PLACEMENT -> (fun _ -> "PLACEMENT") + | MenhirInterpreter.T T_PIXEL -> (fun _ -> "PIXEL") + | MenhirInterpreter.T T_PICTURE_STRING -> (fun _ -> "PICTURE_STRING") + | MenhirInterpreter.T T_PICTURE -> (fun _ -> "PICTURE") + | MenhirInterpreter.T T_PHYSICAL -> (fun _ -> "PHYSICAL") + | MenhirInterpreter.T T_PH -> (fun _ -> "PH") + | MenhirInterpreter.T T_PF -> (fun _ -> "PF") + | MenhirInterpreter.T T_PERMANENT -> (fun _ -> "PERMANENT") + | MenhirInterpreter.T T_PERIOD -> (fun _ -> ".") + | MenhirInterpreter.T T_PERFORM -> (fun _ -> "PERFORM") + | MenhirInterpreter.T T_PASSWORD -> (fun _ -> "PASSWORD") + | MenhirInterpreter.T T_PASCAL -> (fun _ -> "PASCAL") + | MenhirInterpreter.T T_PARSE -> (fun _ -> "PARSE") + | MenhirInterpreter.T T_PARENT -> (fun _ -> "PARENT") + | MenhirInterpreter.T T_PARAGRAPH -> (fun _ -> "PARAGRAPH") + | MenhirInterpreter.T T_PAGE_SETUP -> (fun _ -> "PAGE_SETUP") + | MenhirInterpreter.T T_PAGE_COUNTER -> (fun _ -> "PAGE_COUNTER") + | MenhirInterpreter.T T_PAGED -> (fun _ -> "PAGED") + | MenhirInterpreter.T T_PAGE -> (fun _ -> "PAGE") + | MenhirInterpreter.T T_PADDING -> (fun _ -> "PADDING") + | MenhirInterpreter.T T_PACKED_DECIMAL -> (fun _ -> "PACKED_DECIMAL") + | MenhirInterpreter.T T_OVERRIDING -> (fun _ -> "OVERRIDING") + | MenhirInterpreter.T T_OVERRIDE -> (fun _ -> "OVERRIDE") + | MenhirInterpreter.T T_OVERLINE -> (fun _ -> "OVERLINE") + | MenhirInterpreter.T T_OVERLAP_TOP -> (fun _ -> "OVERLAP_TOP") + | MenhirInterpreter.T T_OVERLAP_LEFT -> (fun _ -> "OVERLAP_LEFT") + | MenhirInterpreter.T T_OVERFLOW -> (fun _ -> "OVERFLOW") + | MenhirInterpreter.T T_OUTPUT -> (fun _ -> "OUTPUT") + | MenhirInterpreter.T T_OTHERS -> (fun _ -> "OTHERS") + | MenhirInterpreter.T T_OTHER -> (fun _ -> "OTHER") + | MenhirInterpreter.T T_ORGANIZATION -> (fun _ -> "ORGANIZATION") + | MenhirInterpreter.T T_ORDER -> (fun _ -> "ORDER") + | MenhirInterpreter.T T_OR -> (fun _ -> "OR") + | MenhirInterpreter.T T_OPTIONS -> (fun _ -> "OPTIONS") + | MenhirInterpreter.T T_OPTIONAL -> (fun _ -> "OPTIONAL") + | MenhirInterpreter.T T_OPERATIONAL -> (fun _ -> "OPERATIONAL") + | MenhirInterpreter.T T_OPEN -> (fun _ -> "OPEN") + | MenhirInterpreter.T T_ON_SIZE_ERROR -> (fun _ -> "ON_SIZE_ERROR") + | MenhirInterpreter.T T_ON_OVERFLOW -> (fun _ -> "ON_OVERFLOW") + | MenhirInterpreter.T T_ON_EXCEPTION -> (fun _ -> "ON_EXCEPTION") + | MenhirInterpreter.T T_ONLY -> (fun _ -> "ONLY") + | MenhirInterpreter.T T_ON -> (fun _ -> "ON") + | MenhirInterpreter.T T_OMITTED -> (fun _ -> "OMITTED") + | MenhirInterpreter.T T_OK_BUTTON -> (fun _ -> "OK_BUTTON") + | MenhirInterpreter.T T_OFF -> (fun _ -> "OFF") + | MenhirInterpreter.T T_OF -> (fun _ -> "OF") + | MenhirInterpreter.T T_OCCURS -> (fun _ -> "OCCURS") + | MenhirInterpreter.T T_OBJECT_REFERENCE -> (fun _ -> "OBJECT_REFERENCE") + | MenhirInterpreter.T T_OBJECT_PROGRAM -> (fun _ -> "OBJECT_PROGRAM") + | MenhirInterpreter.T T_OBJECT_COMPUTER -> (fun _ -> "OBJECT_COMPUTER") + | MenhirInterpreter.T T_OBJECT -> (fun _ -> "OBJECT") + | MenhirInterpreter.T T_NUM_ROWS -> (fun _ -> "NUM_ROWS") + | MenhirInterpreter.T T_NUM_COL_HEADINGS -> (fun _ -> "NUM_COL_HEADINGS") + | MenhirInterpreter.T T_NUMERIC_EDITED -> (fun _ -> "NUMERIC_EDITED") + | MenhirInterpreter.T T_NUMERIC -> (fun _ -> "NUMERIC") + | MenhirInterpreter.T T_NUMBERS -> (fun _ -> "NUMBERS") + | MenhirInterpreter.T T_NUMBER -> (fun _ -> "NUMBER") + | MenhirInterpreter.T T_NULLS -> (fun _ -> "NULLS") + | MenhirInterpreter.T T_NULLIT -> (fun _ -> "NULLIT") + | MenhirInterpreter.T T_NULL -> (fun _ -> "NULL") + | MenhirInterpreter.T T_NO_UPDOWN -> (fun _ -> "NO_UPDOWN") + | MenhirInterpreter.T T_NO_SEARCH -> (fun _ -> "NO_SEARCH") + | MenhirInterpreter.T T_NO_KEY_LETTER -> (fun _ -> "NO_KEY_LETTER") + | MenhirInterpreter.T T_NO_GROUP_TAB -> (fun _ -> "NO_GROUP_TAB") + | MenhirInterpreter.T T_NO_FOCUS -> (fun _ -> "NO_FOCUS") + | MenhirInterpreter.T T_NO_F4 -> (fun _ -> "NO_F4") + | MenhirInterpreter.T T_NO_ECHO -> (fun _ -> "NO_ECHO") + | MenhirInterpreter.T T_NO_DIVIDERS -> (fun _ -> "NO_DIVIDERS") + | MenhirInterpreter.T T_NO_DATA -> (fun _ -> "NO_DATA") + | MenhirInterpreter.T T_NO_BOX -> (fun _ -> "NO_BOX") + | MenhirInterpreter.T T_NO_AUTO_DEFAULT -> (fun _ -> "NO_AUTO_DEFAULT") + | MenhirInterpreter.T T_NO_AUTOSEL -> (fun _ -> "NO_AUTOSEL") + | MenhirInterpreter.T T_NOT_ON_SIZE_ERROR -> (fun _ -> "NOT_ON_SIZE_ERROR") + | MenhirInterpreter.T T_NOT_ON_OVERFLOW -> (fun _ -> "NOT_ON_OVERFLOW") + | MenhirInterpreter.T T_NOT_ON_EXCEPTION -> (fun _ -> "NOT_ON_EXCEPTION") + | MenhirInterpreter.T T_NOT_INVALID_KEY -> (fun _ -> "NOT_INVALID_KEY") + | MenhirInterpreter.T T_NOT_AT_EOP -> (fun _ -> "NOT_AT_EOP") + | MenhirInterpreter.T T_NOT_AT_END -> (fun _ -> "NOT_AT_END") + | MenhirInterpreter.T T_NOTIFY_SELCHANGE -> (fun _ -> "NOTIFY_SELCHANGE") + | MenhirInterpreter.T T_NOTIFY_DBLCLICK -> (fun _ -> "NOTIFY_DBLCLICK") + | MenhirInterpreter.T T_NOTIFY_CHANGE -> (fun _ -> "NOTIFY_CHANGE") + | MenhirInterpreter.T T_NOTIFY -> (fun _ -> "NOTIFY") + | MenhirInterpreter.T T_NOTHING -> (fun _ -> "NOTHING") + | MenhirInterpreter.T T_NOTAB -> (fun _ -> "NOTAB") + | MenhirInterpreter.T T_NOT -> (fun _ -> "NOT") + | MenhirInterpreter.T T_NORMAL -> (fun _ -> "NORMAL") + | MenhirInterpreter.T T_NONNUMERIC -> (fun _ -> "NONNUMERIC") + | MenhirInterpreter.T T_NONE -> (fun _ -> "NONE") + | MenhirInterpreter.T T_NOMINAL -> (fun _ -> "NOMINAL") + | MenhirInterpreter.T T_NO -> (fun _ -> "NO") + | MenhirInterpreter.T T_NEXT_PAGE -> (fun _ -> "NEXT_PAGE") + | MenhirInterpreter.T T_NEXT_ITEM -> (fun _ -> "NEXT_ITEM") + | MenhirInterpreter.T T_NEXT -> (fun _ -> "NEXT") + | MenhirInterpreter.T T_NEW -> (fun _ -> "NEW") + | MenhirInterpreter.T T_NESTED -> (fun _ -> "NESTED") + | MenhirInterpreter.T T_NEGATIVE -> (fun _ -> "NEGATIVE") + | MenhirInterpreter.T T_NEAREST_TO_ZERO -> (fun _ -> "NEAREST_TO_ZERO") + | MenhirInterpreter.T T_NEAREST_TOWARD_ZERO -> (fun _ -> "NEAREST_TOWARD_ZERO") + | MenhirInterpreter.T T_NEAREST_EVEN -> (fun _ -> "NEAREST_EVEN") + | MenhirInterpreter.T T_NEAREST_AWAY_FROM_ZERO -> (fun _ -> "NEAREST_AWAY_FROM_ZERO") + | MenhirInterpreter.T T_NE -> (fun _ -> "<>") + | MenhirInterpreter.T T_NAVIGATE_URL -> (fun _ -> "NAVIGATE_URL") + | MenhirInterpreter.T T_NATLIT -> (fun _ -> "NATLIT") + | MenhirInterpreter.T T_NATIVE -> (fun _ -> "NATIVE") + | MenhirInterpreter.T T_NATIONAL_EDITED -> (fun _ -> "NATIONAL_EDITED") + | MenhirInterpreter.T T_NATIONAL -> (fun _ -> "NATIONAL") + | MenhirInterpreter.T T_NAT -> (fun _ -> "NAT") + | MenhirInterpreter.T T_NAMESPACE_PREFIX -> (fun _ -> "NAMESPACE_PREFIX") + | MenhirInterpreter.T T_NAMESPACE -> (fun _ -> "NAMESPACE") + | MenhirInterpreter.T T_NAMED -> (fun _ -> "NAMED") + | MenhirInterpreter.T T_NAME -> (fun _ -> "NAME") + | MenhirInterpreter.T T_MULTIPLY -> (fun _ -> "MULTIPLY") + | MenhirInterpreter.T T_MULTIPLE -> (fun _ -> "MULTIPLE") + | MenhirInterpreter.T T_MULTILINE -> (fun _ -> "MULTILINE") + | MenhirInterpreter.T T_MOVE -> (fun _ -> "MOVE") + | MenhirInterpreter.T T_MODULES -> (fun _ -> "MODULES") + | MenhirInterpreter.T T_MODIFY -> (fun _ -> "MODIFY") + | MenhirInterpreter.T T_MODE -> (fun _ -> "MODE") + | MenhirInterpreter.T T_MIN_VAL -> (fun _ -> "MIN_VAL") + | MenhirInterpreter.T T_MINUS -> (fun _ -> "MINUS") + | MenhirInterpreter.T T_MICROSECOND_TIME -> (fun _ -> "MICROSECOND_TIME") + | MenhirInterpreter.T T_METHOD_ID -> (fun _ -> "METHOD_ID") + | MenhirInterpreter.T T_METHOD -> (fun _ -> "METHOD") + | MenhirInterpreter.T T_MESSAGE_TAG -> (fun _ -> "MESSAGE_TAG") + | MenhirInterpreter.T T_MESSAGE -> (fun _ -> "MESSAGE") + | MenhirInterpreter.T T_MERGE -> (fun _ -> "MERGE") + | MenhirInterpreter.T T_MENU -> (fun _ -> "MENU") + | MenhirInterpreter.T T_MEMORY -> (fun _ -> "MEMORY") + | MenhirInterpreter.T T_MEDIUM_FONT -> (fun _ -> "MEDIUM_FONT") + | MenhirInterpreter.T T_MAX_VAL -> (fun _ -> "MAX_VAL") + | MenhirInterpreter.T T_MAX_TEXT -> (fun _ -> "MAX_TEXT") + | MenhirInterpreter.T T_MAX_PROGRESS -> (fun _ -> "MAX_PROGRESS") + | MenhirInterpreter.T T_MAX_LINES -> (fun _ -> "MAX_LINES") + | MenhirInterpreter.T T_MASTER_INDEX -> (fun _ -> "MASTER_INDEX") + | MenhirInterpreter.T T_MASS_UPDATE -> (fun _ -> "MASS_UPDATE") + | MenhirInterpreter.T T_MANUAL -> (fun _ -> "MANUAL") + | MenhirInterpreter.T T_MAGNETIC_TAPE -> (fun _ -> "MAGNETIC_TAPE") + | MenhirInterpreter.T T_LT -> (fun _ -> "<") + | MenhirInterpreter.T T_LPAR -> (fun _ -> "(") + | MenhirInterpreter.T T_LOW_VALUE -> (fun _ -> "LOW_VALUE") + | MenhirInterpreter.T T_LOW_COLOR -> (fun _ -> "LOW_COLOR") + | MenhirInterpreter.T T_LOWLIGHT -> (fun _ -> "LOWLIGHT") + | MenhirInterpreter.T T_LOWERED -> (fun _ -> "LOWERED") + | MenhirInterpreter.T T_LOWER -> (fun _ -> "LOWER") + | MenhirInterpreter.T T_LONG_DATE -> (fun _ -> "LONG_DATE") + | MenhirInterpreter.T T_LOCK_HOLDING -> (fun _ -> "LOCK_HOLDING") + | MenhirInterpreter.T T_LOCKS -> (fun _ -> "LOCKS") + | MenhirInterpreter.T T_LOCK -> (fun _ -> "LOCK") + | MenhirInterpreter.T T_LOCATION -> (fun _ -> "LOCATION") + | MenhirInterpreter.T T_LOCAL_STORAGE -> (fun _ -> "LOCAL_STORAGE") + | MenhirInterpreter.T T_LOCALE -> (fun _ -> "LOCALE") + | MenhirInterpreter.T T_LOC -> (fun _ -> "LOC") + | MenhirInterpreter.T T_LM_RESIZE -> (fun _ -> "LM_RESIZE") + | MenhirInterpreter.T T_LIST_BOX -> (fun _ -> "LIST_BOX") + | MenhirInterpreter.T T_LINKAGE -> (fun _ -> "LINKAGE") + | MenhirInterpreter.T T_LINE_SEQUENTIAL -> (fun _ -> "LINE_SEQUENTIAL") + | MenhirInterpreter.T T_LINE_COUNTER -> (fun _ -> "LINE_COUNTER") + | MenhirInterpreter.T T_LINES_PER_PAGE -> (fun _ -> "LINES_PER_PAGE") + | MenhirInterpreter.T T_LINES_AT_ROOT -> (fun _ -> "LINES_AT_ROOT") + | MenhirInterpreter.T T_LINES -> (fun _ -> "LINES") + | MenhirInterpreter.T T_LINE -> (fun _ -> "LINE") + | MenhirInterpreter.T T_LINAGE_COUNTER -> (fun _ -> "LINAGE_COUNTER") + | MenhirInterpreter.T T_LINAGE -> (fun _ -> "LINAGE") + | MenhirInterpreter.T T_LIMITS -> (fun _ -> "LIMITS") + | MenhirInterpreter.T T_LIMIT -> (fun _ -> "LIMIT") + | MenhirInterpreter.T T_LIKE -> (fun _ -> "LIKE") + | MenhirInterpreter.T T_LIBRARY -> (fun _ -> "LIBRARY") + | MenhirInterpreter.T T_LESS -> (fun _ -> "LESS") + | MenhirInterpreter.T T_LENGTH -> (fun _ -> "LENGTH") + | MenhirInterpreter.T T_LEFT_TEXT -> (fun _ -> "LEFT_TEXT") + | MenhirInterpreter.T T_LEFT_JUSTIFY -> (fun _ -> "LEFT_JUSTIFY") + | MenhirInterpreter.T T_LEFTLINE -> (fun _ -> "LEFTLINE") + | MenhirInterpreter.T T_LEFT -> (fun _ -> "LEFT") + | MenhirInterpreter.T T_LEAVE -> (fun _ -> "LEAVE") + | MenhirInterpreter.T T_LEADING_SHIFT -> (fun _ -> "LEADING_SHIFT") + | MenhirInterpreter.T T_LEADING -> (fun _ -> "LEADING") + | MenhirInterpreter.T T_LE -> (fun _ -> "<=") + | MenhirInterpreter.T T_LC_TIME -> (fun _ -> "LC_TIME") + | MenhirInterpreter.T T_LC_NUMERIC -> (fun _ -> "LC_NUMERIC") + | MenhirInterpreter.T T_LC_MONETARY -> (fun _ -> "LC_MONETARY") + | MenhirInterpreter.T T_LC_MESSAGES -> (fun _ -> "LC_MESSAGES") + | MenhirInterpreter.T T_LC_CTYPE -> (fun _ -> "LC_CTYPE") + | MenhirInterpreter.T T_LC_COLLATE -> (fun _ -> "LC_COLLATE") + | MenhirInterpreter.T T_LC_ALL -> (fun _ -> "LC_ALL") + | MenhirInterpreter.T T_LAYOUT_MANAGER -> (fun _ -> "LAYOUT_MANAGER") + | MenhirInterpreter.T T_LAYOUT_DATA -> (fun _ -> "LAYOUT_DATA") + | MenhirInterpreter.T T_LAST_ROW -> (fun _ -> "LAST_ROW") + | MenhirInterpreter.T T_LAST -> (fun _ -> "LAST") + | MenhirInterpreter.T T_LARGE_OFFSET -> (fun _ -> "LARGE_OFFSET") + | MenhirInterpreter.T T_LARGE_FONT -> (fun _ -> "LARGE_FONT") + | MenhirInterpreter.T T_LABEL_OFFSET -> (fun _ -> "LABEL_OFFSET") + | MenhirInterpreter.T T_LABEL -> (fun _ -> "LABEL") + | MenhirInterpreter.T T_KEY_LOCATION -> (fun _ -> "KEY_LOCATION") + | MenhirInterpreter.T T_KEYED -> (fun _ -> "KEYED") + | MenhirInterpreter.T T_KEYBOARD -> (fun _ -> "KEYBOARD") + | MenhirInterpreter.T T_KEY -> (fun _ -> "KEY") + | MenhirInterpreter.T T_KEPT -> (fun _ -> "KEPT") + | MenhirInterpreter.T T_JUSTIFIED -> (fun _ -> "JUSTIFIED") + | MenhirInterpreter.T T_JSON -> (fun _ -> "JSON") + | MenhirInterpreter.T T_I_O_CONTROL -> (fun _ -> "I_O_CONTROL") + | MenhirInterpreter.T T_I_O -> (fun _ -> "I_O") + | MenhirInterpreter.T T_ITEM_VALUE -> (fun _ -> "ITEM_VALUE") + | MenhirInterpreter.T T_ITEM_TO_EMPTY -> (fun _ -> "ITEM_TO_EMPTY") + | MenhirInterpreter.T T_ITEM_TO_DELETE -> (fun _ -> "ITEM_TO_DELETE") + | MenhirInterpreter.T T_ITEM_TO_ADD -> (fun _ -> "ITEM_TO_ADD") + | MenhirInterpreter.T T_ITEM_TEXT -> (fun _ -> "ITEM_TEXT") + | MenhirInterpreter.T T_ITEM -> (fun _ -> "ITEM") + | MenhirInterpreter.T T_IS_TYPEDEF -> (fun _ -> "IS_TYPEDEF") + | MenhirInterpreter.T T_IS_GLOBAL -> (fun _ -> "IS_GLOBAL") + | MenhirInterpreter.T T_IS_EXTERNAL -> (fun _ -> "IS_EXTERNAL") + | MenhirInterpreter.T T_IS -> (fun _ -> "IS") + | MenhirInterpreter.T T_IN_ARITHMETIC_RANGE -> (fun _ -> "IN_ARITHMETIC_RANGE") + | MenhirInterpreter.T T_INVOKING -> (fun _ -> "INVOKING") + | MenhirInterpreter.T T_INVOKE -> (fun _ -> "INVOKE") + | MenhirInterpreter.T T_INVALID_KEY -> (fun _ -> "INVALID_KEY") + | MenhirInterpreter.T T_INVALID -> (fun _ -> "INVALID") + | MenhirInterpreter.T T_INTRINSIC -> (fun _ -> "INTRINSIC") + | MenhirInterpreter.T T_INTO -> (fun _ -> "INTO") + | MenhirInterpreter.T T_INTERVENING_ -> (fun _ -> "INTERVENING_") + | MenhirInterpreter.T T_INTERMEDIATE -> (fun _ -> "INTERMEDIATE") + | MenhirInterpreter.T T_INTERFACE_ID -> (fun _ -> "INTERFACE_ID") + | MenhirInterpreter.T T_INTERFACE -> (fun _ -> "INTERFACE") + | MenhirInterpreter.T T_INSTALLATION -> (fun _ -> "INSTALLATION") + | MenhirInterpreter.T T_INSPECT -> (fun _ -> "INSPECT") + | MenhirInterpreter.T T_INSERT_ROWS -> (fun _ -> "INSERT_ROWS") + | MenhirInterpreter.T T_INSERTION_INDEX -> (fun _ -> "INSERTION_INDEX") + | MenhirInterpreter.T T_INQUIRE -> (fun _ -> "INQUIRE") + | MenhirInterpreter.T T_INPUT_OUTPUT -> (fun _ -> "INPUT_OUTPUT") + | MenhirInterpreter.T T_INPUT -> (fun _ -> "INPUT") + | MenhirInterpreter.T T_INITIATE -> (fun _ -> "INITIATE") + | MenhirInterpreter.T T_INITIALIZED -> (fun _ -> "INITIALIZED") + | MenhirInterpreter.T T_INITIALIZE -> (fun _ -> "INITIALIZE") + | MenhirInterpreter.T T_INITIAL -> (fun _ -> "INITIAL") + | MenhirInterpreter.T T_INHERITS -> (fun _ -> "INHERITS") + | MenhirInterpreter.T T_INDICATE -> (fun _ -> "INDICATE") + | MenhirInterpreter.T T_INDEX_2 -> (fun _ -> "INDEX_2") + | MenhirInterpreter.T T_INDEX_1 -> (fun _ -> "INDEX_1") + | MenhirInterpreter.T T_INDEXED -> (fun _ -> "INDEXED") + | MenhirInterpreter.T T_INDEX -> (fun _ -> "INDEX") + | MenhirInterpreter.T T_INDEPENDENT -> (fun _ -> "INDEPENDENT") + | MenhirInterpreter.T T_IN -> (fun _ -> "IN") + | MenhirInterpreter.T T_IMPLEMENTS -> (fun _ -> "IMPLEMENTS") + | MenhirInterpreter.T T_IGNORING -> (fun _ -> "IGNORING") + | MenhirInterpreter.T T_IGNORE -> (fun _ -> "IGNORE") + | MenhirInterpreter.T T_IF -> (fun _ -> "IF") + | MenhirInterpreter.T T_IDS_II -> (fun _ -> "IDS_II") + | MenhirInterpreter.T T_IDENTIFIED -> (fun _ -> "IDENTIFIED") + | MenhirInterpreter.T T_IDENTIFICATION -> (fun _ -> "IDENTIFICATION") + | MenhirInterpreter.T T_ID -> (fun _ -> "ID") + | MenhirInterpreter.T T_ICON -> (fun _ -> "ICON") + | MenhirInterpreter.T T_HSCROLL_POS -> (fun _ -> "HSCROLL_POS") + | MenhirInterpreter.T T_HSCROLL -> (fun _ -> "HSCROLL") + | MenhirInterpreter.T T_HOT_TRACK -> (fun _ -> "HOT_TRACK") + | MenhirInterpreter.T T_HIGH_VALUE -> (fun _ -> "HIGH_VALUE") + | MenhirInterpreter.T T_HIGH_ORDER_RIGHT -> (fun _ -> "HIGH_ORDER_RIGHT") + | MenhirInterpreter.T T_HIGH_ORDER_LEFT -> (fun _ -> "HIGH_ORDER_LEFT") + | MenhirInterpreter.T T_HIGH_COLOR -> (fun _ -> "HIGH_COLOR") + | MenhirInterpreter.T T_HIGHLIGHT -> (fun _ -> "HIGHLIGHT") + | MenhirInterpreter.T T_HIDDEN_DATA -> (fun _ -> "HIDDEN_DATA") + | MenhirInterpreter.T T_HEXLIT -> (fun _ -> "HEXLIT") + | MenhirInterpreter.T T_HEX -> (fun _ -> "HEX") + | MenhirInterpreter.T T_HEIGHT_IN_CELLS -> (fun _ -> "HEIGHT_IN_CELLS") + | MenhirInterpreter.T T_HEAVY -> (fun _ -> "HEAVY") + | MenhirInterpreter.T T_HEADING_FONT -> (fun _ -> "HEADING_FONT") + | MenhirInterpreter.T T_HEADING_DIVIDER_COLOR -> (fun _ -> "HEADING_DIVIDER_COLOR") + | MenhirInterpreter.T T_HEADING_COLOR -> (fun _ -> "HEADING_COLOR") + | MenhirInterpreter.T T_HEADING -> (fun _ -> "HEADING") + | MenhirInterpreter.T T_HAS_CHILDREN -> (fun _ -> "HAS_CHILDREN") + | MenhirInterpreter.T T_HANDLE -> (fun _ -> "HANDLE") + | MenhirInterpreter.T T_GT -> (fun _ -> ">") + | MenhirInterpreter.T T_GROUP_VALUE -> (fun _ -> "GROUP_VALUE") + | MenhirInterpreter.T T_GROUP_USAGE -> (fun _ -> "GROUP_USAGE") + | MenhirInterpreter.T T_GROUP -> (fun _ -> "GROUP") + | MenhirInterpreter.T T_GRID -> (fun _ -> "GRID") + | MenhirInterpreter.T T_GREATER -> (fun _ -> "GREATER") + | MenhirInterpreter.T T_GRAPHICAL -> (fun _ -> "GRAPHICAL") + | MenhirInterpreter.T T_GO_SEARCH -> (fun _ -> "GO_SEARCH") + | MenhirInterpreter.T T_GO_HOME -> (fun _ -> "GO_HOME") + | MenhirInterpreter.T T_GO_FORWARD -> (fun _ -> "GO_FORWARD") + | MenhirInterpreter.T T_GO_BACK -> (fun _ -> "GO_BACK") + | MenhirInterpreter.T T_GOBACK -> (fun _ -> "GOBACK") + | MenhirInterpreter.T T_GO -> (fun _ -> "GO") + | MenhirInterpreter.T T_GLOBAL -> (fun _ -> "GLOBAL") + | MenhirInterpreter.T T_GIVING -> (fun _ -> "GIVING") + | MenhirInterpreter.T T_GET -> (fun _ -> "GET") + | MenhirInterpreter.T T_GENERATE -> (fun _ -> "GENERATE") + | MenhirInterpreter.T T_GE -> (fun _ -> ">=") + | MenhirInterpreter.T T_GCOS -> (fun _ -> "GCOS") + | MenhirInterpreter.T T_FUNCTION_POINTER -> (fun _ -> "FUNCTION_POINTER") + | MenhirInterpreter.T T_FUNCTION_ID -> (fun _ -> "FUNCTION_ID") + | MenhirInterpreter.T T_FUNCTION -> (fun _ -> "FUNCTION") + | MenhirInterpreter.T T_FULL_HEIGHT -> (fun _ -> "FULL_HEIGHT") + | MenhirInterpreter.T T_FULL -> (fun _ -> "FULL") + | MenhirInterpreter.T T_FROM -> (fun _ -> "FROM") + | MenhirInterpreter.T T_FREE -> (fun _ -> "FREE") + | MenhirInterpreter.T T_FRAMED -> (fun _ -> "FRAMED") + | MenhirInterpreter.T T_FRAME -> (fun _ -> "FRAME") + | MenhirInterpreter.T T_FORMAT -> (fun _ -> "FORMAT") + | MenhirInterpreter.T T_FOREVER -> (fun _ -> "FOREVER") + | MenhirInterpreter.T T_FOREGROUND_COLOR -> (fun _ -> "FOREGROUND_COLOR") + | MenhirInterpreter.T T_FOR -> (fun _ -> "FOR") + | MenhirInterpreter.T T_FOOTING -> (fun _ -> "FOOTING") + | MenhirInterpreter.T T_FONT -> (fun _ -> "FONT") + | MenhirInterpreter.T T_FLR -> (fun _ -> "FLR") + | MenhirInterpreter.T T_FLOAT_SHORT -> (fun _ -> "FLOAT_SHORT") + | MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_SIGNALING -> (fun _ -> "FLOAT_NOT_A_NUMBER_SIGNALING") + | MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_QUIET -> (fun _ -> "FLOAT_NOT_A_NUMBER_QUIET") + | MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER -> (fun _ -> "FLOAT_NOT_A_NUMBER") + | MenhirInterpreter.T T_FLOAT_LONG -> (fun _ -> "FLOAT_LONG") + | MenhirInterpreter.T T_FLOAT_INFINITY -> (fun _ -> "FLOAT_INFINITY") + | MenhirInterpreter.T T_FLOAT_EXTENDED -> (fun _ -> "FLOAT_EXTENDED") + | MenhirInterpreter.T T_FLOAT_DECIMAL_34 -> (fun _ -> "FLOAT_DECIMAL_34") + | MenhirInterpreter.T T_FLOAT_DECIMAL_16 -> (fun _ -> "FLOAT_DECIMAL_16") + | MenhirInterpreter.T T_FLOAT_DECIMAL -> (fun _ -> "FLOAT_DECIMAL") + | MenhirInterpreter.T T_FLOAT_BINARY_64 -> (fun _ -> "FLOAT_BINARY_64") + | MenhirInterpreter.T T_FLOAT_BINARY_32 -> (fun _ -> "FLOAT_BINARY_32") + | MenhirInterpreter.T T_FLOAT_BINARY_128 -> (fun _ -> "FLOAT_BINARY_128") + | MenhirInterpreter.T T_FLOAT_BINARY -> (fun _ -> "FLOAT_BINARY") + | MenhirInterpreter.T T_FLOATLIT -> (fun _ -> "FLOATLIT") + | MenhirInterpreter.T T_FLOATING -> (fun _ -> "FLOATING") + | MenhirInterpreter.T T_FLOAT -> (fun _ -> "FLOAT") + | MenhirInterpreter.T T_FLAT_BUTTONS -> (fun _ -> "FLAT_BUTTONS") + | MenhirInterpreter.T T_FLAT -> (fun _ -> "FLAT") + | MenhirInterpreter.T T_FIXED_WIDTH -> (fun _ -> "FIXED_WIDTH") + | MenhirInterpreter.T T_FIXED_FONT -> (fun _ -> "FIXED_FONT") + | MenhirInterpreter.T T_FIXEDLIT -> (fun _ -> "FIXEDLIT") + | MenhirInterpreter.T T_FIXED -> (fun _ -> "FIXED") + | MenhirInterpreter.T T_FIRST -> (fun _ -> "FIRST") + | MenhirInterpreter.T T_FINISH_REASON -> (fun _ -> "FINISH_REASON") + | MenhirInterpreter.T T_FINALLY -> (fun _ -> "FINALLY") + | MenhirInterpreter.T T_FINAL -> (fun _ -> "FINAL") + | MenhirInterpreter.T T_FILL_PERCENT -> (fun _ -> "FILL_PERCENT") + | MenhirInterpreter.T T_FILL_COLOR2 -> (fun _ -> "FILL_COLOR2") + | MenhirInterpreter.T T_FILL_COLOR -> (fun _ -> "FILL_COLOR") + | MenhirInterpreter.T T_FILLER -> (fun _ -> "FILLER") + | MenhirInterpreter.T T_FILE_POS -> (fun _ -> "FILE_POS") + | MenhirInterpreter.T T_FILE_NAME -> (fun _ -> "FILE_NAME") + | MenhirInterpreter.T T_FILE_LIMITS -> (fun _ -> "FILE_LIMITS") + | MenhirInterpreter.T T_FILE_LIMIT -> (fun _ -> "FILE_LIMIT") + | MenhirInterpreter.T T_FILE_ID -> (fun _ -> "FILE_ID") + | MenhirInterpreter.T T_FILE_CONTROL -> (fun _ -> "FILE_CONTROL") + | MenhirInterpreter.T T_FILES -> (fun _ -> "FILES") + | MenhirInterpreter.T T_FILE -> (fun _ -> "FILE") + | MenhirInterpreter.T T_FH__KEYDEF -> (fun _ -> "FH__KEYDEF") + | MenhirInterpreter.T T_FH__FCD -> (fun _ -> "FH__FCD") + | MenhirInterpreter.T T_FD -> (fun _ -> "FD") + | MenhirInterpreter.T T_FARTHEST_FROM_ZERO -> (fun _ -> "FARTHEST_FROM_ZERO") + | MenhirInterpreter.T T_FALSE -> (fun _ -> "FALSE") + | MenhirInterpreter.T T_FACTORY -> (fun _ -> "FACTORY") + | MenhirInterpreter.T T_F -> (fun _ -> "F") + | MenhirInterpreter.T T_EXTERNAL_FORM -> (fun _ -> "EXTERNAL_FORM") + | MenhirInterpreter.T T_EXTERNAL -> (fun _ -> "EXTERNAL") + | MenhirInterpreter.T T_EXTERN -> (fun _ -> "EXTERN") + | MenhirInterpreter.T T_EXTENDED_SEARCH -> (fun _ -> "EXTENDED_SEARCH") + | MenhirInterpreter.T T_EXTEND -> (fun _ -> "EXTEND") + | MenhirInterpreter.T T_EXPANDS -> (fun _ -> "EXPANDS") + | MenhirInterpreter.T T_EXPAND -> (fun _ -> "EXPAND") + | MenhirInterpreter.T T_EXIT -> (fun _ -> "EXIT") + | MenhirInterpreter.T T_EXHIBIT -> (fun _ -> "EXHIBIT") + | MenhirInterpreter.T T_EXCLUSIVE_OR -> (fun _ -> "EXCLUSIVE_OR") + | MenhirInterpreter.T T_EXCLUSIVE -> (fun _ -> "EXCLUSIVE") + | MenhirInterpreter.T T_EXCEPTION_VALUE -> (fun _ -> "EXCEPTION_VALUE") + | MenhirInterpreter.T T_EXCEPTION_OBJECT -> (fun _ -> "EXCEPTION_OBJECT") + | MenhirInterpreter.T T_EXCEPTION -> (fun _ -> "EXCEPTION") + | MenhirInterpreter.T T_EXAMINE -> (fun _ -> "EXAMINE") + | MenhirInterpreter.T T_EVERY -> (fun _ -> "EVERY") + | MenhirInterpreter.T T_EVENT_LIST -> (fun _ -> "EVENT_LIST") + | MenhirInterpreter.T T_EVENT -> (fun _ -> "EVENT") + | MenhirInterpreter.T T_EVALUATE -> (fun _ -> "EVALUATE") + | MenhirInterpreter.T T_ESI -> (fun _ -> "ESI") + | MenhirInterpreter.T T_ESCAPE_BUTTON -> (fun _ -> "ESCAPE_BUTTON") + | MenhirInterpreter.T T_ESCAPE -> (fun _ -> "ESCAPE") + | MenhirInterpreter.T T_ERROR -> (fun _ -> "ERROR") + | MenhirInterpreter.T T_ERASE -> (fun _ -> "ERASE") + | MenhirInterpreter.T T_EQUAL -> (fun _ -> "EQUAL") + | MenhirInterpreter.T T_EQ -> (fun _ -> "=") + | MenhirInterpreter.T T_EOS -> (fun _ -> "EOS") + | MenhirInterpreter.T T_EOP -> (fun _ -> "EOP") + | MenhirInterpreter.T T_EOL -> (fun _ -> "EOL") + | MenhirInterpreter.T T_EOF -> (fun _ -> "EOF") + | MenhirInterpreter.T T_EO -> (fun _ -> "EO") + | MenhirInterpreter.T T_ENVIRONMENT_VALUE -> (fun _ -> "ENVIRONMENT_VALUE") + | MenhirInterpreter.T T_ENVIRONMENT_NAME -> (fun _ -> "ENVIRONMENT_NAME") + | MenhirInterpreter.T T_ENVIRONMENT -> (fun _ -> "ENVIRONMENT") + | MenhirInterpreter.T T_ENTRY_REASON -> (fun _ -> "ENTRY_REASON") + | MenhirInterpreter.T T_ENTRY_FIELD -> (fun _ -> "ENTRY_FIELD") + | MenhirInterpreter.T T_ENTRY_CONVENTION -> (fun _ -> "ENTRY_CONVENTION") + | MenhirInterpreter.T T_ENTRY -> (fun _ -> "ENTRY") + | MenhirInterpreter.T T_ENTER -> (fun _ -> "ENTER") + | MenhirInterpreter.T T_ENSURE_VISIBLE -> (fun _ -> "ENSURE_VISIBLE") + | MenhirInterpreter.T T_ENGRAVED -> (fun _ -> "ENGRAVED") + | MenhirInterpreter.T T_END_XML -> (fun _ -> "END_XML") + | MenhirInterpreter.T T_END_WRITE -> (fun _ -> "END_WRITE") + | MenhirInterpreter.T T_END_UNSTRING -> (fun _ -> "END_UNSTRING") + | MenhirInterpreter.T T_END_SUBTRACT -> (fun _ -> "END_SUBTRACT") + | MenhirInterpreter.T T_END_STRING -> (fun _ -> "END_STRING") + | MenhirInterpreter.T T_END_START -> (fun _ -> "END_START") + | MenhirInterpreter.T T_END_SEND -> (fun _ -> "END_SEND") + | MenhirInterpreter.T T_END_SEARCH -> (fun _ -> "END_SEARCH") + | MenhirInterpreter.T T_END_REWRITE -> (fun _ -> "END_REWRITE") + | MenhirInterpreter.T T_END_RETURN -> (fun _ -> "END_RETURN") + | MenhirInterpreter.T T_END_RECEIVE -> (fun _ -> "END_RECEIVE") + | MenhirInterpreter.T T_END_READ -> (fun _ -> "END_READ") + | MenhirInterpreter.T T_END_PERFORM -> (fun _ -> "END_PERFORM") + | MenhirInterpreter.T T_END_OF_PAGE -> (fun _ -> "END_OF_PAGE") + | MenhirInterpreter.T T_END_MULTIPLY -> (fun _ -> "END_MULTIPLY") + | MenhirInterpreter.T T_END_MODIFY -> (fun _ -> "END_MODIFY") + | MenhirInterpreter.T T_END_JSON -> (fun _ -> "END_JSON") + | MenhirInterpreter.T T_END_IF -> (fun _ -> "END_IF") + | MenhirInterpreter.T T_END_EVALUATE -> (fun _ -> "END_EVALUATE") + | MenhirInterpreter.T T_END_DIVIDE -> (fun _ -> "END_DIVIDE") + | MenhirInterpreter.T T_END_DISPLAY -> (fun _ -> "END_DISPLAY") + | MenhirInterpreter.T T_END_DELETE -> (fun _ -> "END_DELETE") + | MenhirInterpreter.T T_END_COMPUTE -> (fun _ -> "END_COMPUTE") + | MenhirInterpreter.T T_END_COLOR -> (fun _ -> "END_COLOR") + | MenhirInterpreter.T T_END_CHAIN -> (fun _ -> "END_CHAIN") + | MenhirInterpreter.T T_END_CALL -> (fun _ -> "END_CALL") + | MenhirInterpreter.T T_END_ADD -> (fun _ -> "END_ADD") + | MenhirInterpreter.T T_END_ACCEPT -> (fun _ -> "END_ACCEPT") + | MenhirInterpreter.T T_ENDING -> (fun _ -> "ENDING") + | MenhirInterpreter.T T_END -> (fun _ -> "END") + | MenhirInterpreter.T T_ENCRYPTION -> (fun _ -> "ENCRYPTION") + | MenhirInterpreter.T T_ENCODING -> (fun _ -> "ENCODING") + | MenhirInterpreter.T T_ENABLE -> (fun _ -> "ENABLE") + | MenhirInterpreter.T T_EMI -> (fun _ -> "EMI") + | MenhirInterpreter.T T_ELSE -> (fun _ -> "ELSE") + | MenhirInterpreter.T T_ELEMENT -> (fun _ -> "ELEMENT") + | MenhirInterpreter.T T_EIGHTY_EIGHT -> (fun _ -> "EIGHTY_EIGHT") + | MenhirInterpreter.T T_EGI -> (fun _ -> "EGI") + | MenhirInterpreter.T T_EDITING -> (fun _ -> "EDITING") + | MenhirInterpreter.T T_ECHO -> (fun _ -> "ECHO") + | MenhirInterpreter.T T_EC -> (fun _ -> "EC") + | MenhirInterpreter.T T_EBCDIC -> (fun _ -> "EBCDIC") + | MenhirInterpreter.T T_DYNAMIC -> (fun _ -> "DYNAMIC") + | MenhirInterpreter.T T_DUPLICATES -> (fun _ -> "DUPLICATES") + | MenhirInterpreter.T T_DROP_LIST -> (fun _ -> "DROP_LIST") + | MenhirInterpreter.T T_DROP_DOWN -> (fun _ -> "DROP_DOWN") + | MenhirInterpreter.T T_DRAG_COLOR -> (fun _ -> "DRAG_COLOR") + | MenhirInterpreter.T T_DOWN -> (fun _ -> "DOWN") + | MenhirInterpreter.T T_DOUBLE_COLON -> (fun _ -> "::") + | MenhirInterpreter.T T_DOUBLE_ASTERISK -> (fun _ -> "**") + | MenhirInterpreter.T T_DOUBLE -> (fun _ -> "DOUBLE") + | MenhirInterpreter.T T_DOTTED -> (fun _ -> "DOTTED") + | MenhirInterpreter.T T_DOTDASH -> (fun _ -> "DOTDASH") + | MenhirInterpreter.T T_DIVISION -> (fun _ -> "DIVISION") + | MenhirInterpreter.T T_DIVIDER_COLOR -> (fun _ -> "DIVIDER_COLOR") + | MenhirInterpreter.T T_DIVIDERS -> (fun _ -> "DIVIDERS") + | MenhirInterpreter.T T_DIVIDE -> (fun _ -> "DIVIDE") + | MenhirInterpreter.T T_DISPLAY_FORMAT -> (fun _ -> "DISPLAY_FORMAT") + | MenhirInterpreter.T T_DISPLAY_COLUMNS -> (fun _ -> "DISPLAY_COLUMNS") + | MenhirInterpreter.T T_DISPLAY_4 -> (fun _ -> "DISPLAY_4") + | MenhirInterpreter.T T_DISPLAY_3 -> (fun _ -> "DISPLAY_3") + | MenhirInterpreter.T T_DISPLAY_2 -> (fun _ -> "DISPLAY_2") + | MenhirInterpreter.T T_DISPLAY_1 -> (fun _ -> "DISPLAY_1") + | MenhirInterpreter.T T_DISPLAY -> (fun _ -> "DISPLAY") + | MenhirInterpreter.T T_DISP -> (fun _ -> "DISP") + | MenhirInterpreter.T T_DISK -> (fun _ -> "DISK") + | MenhirInterpreter.T T_DISCONNECT -> (fun _ -> "DISCONNECT") + | MenhirInterpreter.T T_DISC -> (fun _ -> "DISC") + | MenhirInterpreter.T T_DISABLE -> (fun _ -> "DISABLE") + | MenhirInterpreter.T T_DIGITS -> (fun _ -> "DIGITS") + | MenhirInterpreter.T T_DETAIL -> (fun _ -> "DETAIL") + | MenhirInterpreter.T T_DESTROY -> (fun _ -> "DESTROY") + | MenhirInterpreter.T T_DESTINATION -> (fun _ -> "DESTINATION") + | MenhirInterpreter.T T_DESCENDING -> (fun _ -> "DESCENDING") + | MenhirInterpreter.T T_DEPENDING -> (fun _ -> "DEPENDING") + | MenhirInterpreter.T T_DELIMITER -> (fun _ -> "DELIMITER") + | MenhirInterpreter.T T_DELIMITED -> (fun _ -> "DELIMITED") + | MenhirInterpreter.T T_DELETE -> (fun _ -> "DELETE") + | MenhirInterpreter.T T_DEFINITION -> (fun _ -> "DEFINITION") + | MenhirInterpreter.T T_DEFAULT_FONT -> (fun _ -> "DEFAULT_FONT") + | MenhirInterpreter.T T_DEFAULT_BUTTON -> (fun _ -> "DEFAULT_BUTTON") + | MenhirInterpreter.T T_DEFAULT -> (fun _ -> "DEFAULT") + | MenhirInterpreter.T T_DECLARATIVES -> (fun _ -> "DECLARATIVES") + | MenhirInterpreter.T T_DECIMAL_POINT -> (fun _ -> "DECIMAL_POINT") + | MenhirInterpreter.T T_DECIMAL_ENCODING -> (fun _ -> "DECIMAL_ENCODING") + | MenhirInterpreter.T T_DEBUG_SUB_3 -> (fun _ -> "DEBUG_SUB_3") + | MenhirInterpreter.T T_DEBUG_SUB_2 -> (fun _ -> "DEBUG_SUB_2") + | MenhirInterpreter.T T_DEBUG_SUB_1 -> (fun _ -> "DEBUG_SUB_1") + | MenhirInterpreter.T T_DEBUG_NAME -> (fun _ -> "DEBUG_NAME") + | MenhirInterpreter.T T_DEBUG_LINE -> (fun _ -> "DEBUG_LINE") + | MenhirInterpreter.T T_DEBUG_ITEM -> (fun _ -> "DEBUG_ITEM") + | MenhirInterpreter.T T_DEBUG_CONTENTS -> (fun _ -> "DEBUG_CONTENTS") + | MenhirInterpreter.T T_DEBUGGING -> (fun _ -> "DEBUGGING") + | MenhirInterpreter.T T_DAY_OF_WEEK -> (fun _ -> "DAY_OF_WEEK") + | MenhirInterpreter.T T_DAY -> (fun _ -> "DAY") + | MenhirInterpreter.T T_DATE_WRITTEN -> (fun _ -> "DATE_WRITTEN") + | MenhirInterpreter.T T_DATE_MODIFIED -> (fun _ -> "DATE_MODIFIED") + | MenhirInterpreter.T T_DATE_ENTRY -> (fun _ -> "DATE_ENTRY") + | MenhirInterpreter.T T_DATE_COMPILED -> (fun _ -> "DATE_COMPILED") + | MenhirInterpreter.T T_DATE -> (fun _ -> "DATE") + | MenhirInterpreter.T T_DATA_TYPES -> (fun _ -> "DATA_TYPES") + | MenhirInterpreter.T T_DATA_RECORDS -> (fun _ -> "DATA_RECORDS") + | MenhirInterpreter.T T_DATA_RECORD -> (fun _ -> "DATA_RECORD") + | MenhirInterpreter.T T_DATA_POINTER -> (fun _ -> "DATA_POINTER") + | MenhirInterpreter.T T_DATA_COLUMNS -> (fun _ -> "DATA_COLUMNS") + | MenhirInterpreter.T T_DATA -> (fun _ -> "DATA") + | MenhirInterpreter.T T_DASH_SIGN -> (fun _ -> "-") + | MenhirInterpreter.T T_DASHED -> (fun _ -> "DASHED") + | MenhirInterpreter.T T_CYL_OVERFLOW -> (fun _ -> "CYL_OVERFLOW") + | MenhirInterpreter.T T_CYL_INDEX -> (fun _ -> "CYL_INDEX") + | MenhirInterpreter.T T_CYCLE -> (fun _ -> "CYCLE") + | MenhirInterpreter.T T_CUSTOM_PRINT_TEMPLATE -> (fun _ -> "CUSTOM_PRINT_TEMPLATE") + | MenhirInterpreter.T T_CURSOR_Y -> (fun _ -> "CURSOR_Y") + | MenhirInterpreter.T T_CURSOR_X -> (fun _ -> "CURSOR_X") + | MenhirInterpreter.T T_CURSOR_ROW -> (fun _ -> "CURSOR_ROW") + | MenhirInterpreter.T T_CURSOR_FRAME_WIDTH -> (fun _ -> "CURSOR_FRAME_WIDTH") + | MenhirInterpreter.T T_CURSOR_COLOR -> (fun _ -> "CURSOR_COLOR") + | MenhirInterpreter.T T_CURSOR_COL -> (fun _ -> "CURSOR_COL") + | MenhirInterpreter.T T_CURSOR -> (fun _ -> "CURSOR") + | MenhirInterpreter.T T_CURRENT -> (fun _ -> "CURRENT") + | MenhirInterpreter.T T_CURRENCY -> (fun _ -> "CURRENCY") + | MenhirInterpreter.T T_CS_GENERAL -> (fun _ -> "CS_GENERAL") + | MenhirInterpreter.T T_CS_BASIC -> (fun _ -> "CS_BASIC") + | MenhirInterpreter.T T_CSIZE -> (fun _ -> "CSIZE") + | MenhirInterpreter.T T_CRT_UNDER -> (fun _ -> "CRT_UNDER") + | MenhirInterpreter.T T_CRT -> (fun _ -> "CRT") + | MenhirInterpreter.T T_COUNT -> (fun _ -> "COUNT") + | MenhirInterpreter.T T_CORRESPONDING -> (fun _ -> "CORRESPONDING") + | MenhirInterpreter.T T_CORE_INDEX -> (fun _ -> "CORE_INDEX") + | MenhirInterpreter.T T_COPY_SELECTION -> (fun _ -> "COPY_SELECTION") + | MenhirInterpreter.T T_COPY -> (fun _ -> "COPY") + | MenhirInterpreter.T T_CONVERTING -> (fun _ -> "CONVERTING") + | MenhirInterpreter.T T_CONVERSION -> (fun _ -> "CONVERSION") + | MenhirInterpreter.T T_CONTROLS -> (fun _ -> "CONTROLS") + | MenhirInterpreter.T T_CONTROL -> (fun _ -> "CONTROL") + | MenhirInterpreter.T T_CONTINUE -> (fun _ -> "CONTINUE") + | MenhirInterpreter.T T_CONTENT -> (fun _ -> "CONTENT") + | MenhirInterpreter.T T_CONTAINS -> (fun _ -> "CONTAINS") + | MenhirInterpreter.T T_CONSTANT -> (fun _ -> "CONSTANT") + | MenhirInterpreter.T T_CONSOLE_3 -> (fun _ -> "CONSOLE_3") + | MenhirInterpreter.T T_CONSOLE_2 -> (fun _ -> "CONSOLE_2") + | MenhirInterpreter.T T_CONSOLE_1 -> (fun _ -> "CONSOLE_1") + | MenhirInterpreter.T T_CONSOLE_0 -> (fun _ -> "CONSOLE_0") + | MenhirInterpreter.T T_CONNECT -> (fun _ -> "CONNECT") + | MenhirInterpreter.T T_CONFIGURATION -> (fun _ -> "CONFIGURATION") + | MenhirInterpreter.T T_CONDITION -> (fun _ -> "CONDITION") + | MenhirInterpreter.T T_COMP_X -> (fun _ -> "COMP_X") + | MenhirInterpreter.T T_COMP_N -> (fun _ -> "COMP_N") + | MenhirInterpreter.T T_COMP_9 -> (fun _ -> "COMP_9") + | MenhirInterpreter.T T_COMP_7 -> (fun _ -> "COMP_7") + | MenhirInterpreter.T T_COMP_6 -> (fun _ -> "COMP_6") + | MenhirInterpreter.T T_COMP_5 -> (fun _ -> "COMP_5") + | MenhirInterpreter.T T_COMP_4 -> (fun _ -> "COMP_4") + | MenhirInterpreter.T T_COMP_3 -> (fun _ -> "COMP_3") + | MenhirInterpreter.T T_COMP_2 -> (fun _ -> "COMP_2") + | MenhirInterpreter.T T_COMP_15 -> (fun _ -> "COMP_15") + | MenhirInterpreter.T T_COMP_14 -> (fun _ -> "COMP_14") + | MenhirInterpreter.T T_COMP_13 -> (fun _ -> "COMP_13") + | MenhirInterpreter.T T_COMP_12 -> (fun _ -> "COMP_12") + | MenhirInterpreter.T T_COMP_11 -> (fun _ -> "COMP_11") + | MenhirInterpreter.T T_COMP_10 -> (fun _ -> "COMP_10") + | MenhirInterpreter.T T_COMP_1 -> (fun _ -> "COMP_1") + | MenhirInterpreter.T T_COMP_0 -> (fun _ -> "COMP_0") + | MenhirInterpreter.T T_COMPUTE -> (fun _ -> "COMPUTE") + | MenhirInterpreter.T T_COMPUTATIONAL_7 -> (fun _ -> "COMPUTATIONAL_7") + | MenhirInterpreter.T T_COMPUTATIONAL_14 -> (fun _ -> "COMPUTATIONAL_14") + | MenhirInterpreter.T T_COMPUTATIONAL_13 -> (fun _ -> "COMPUTATIONAL_13") + | MenhirInterpreter.T T_COMPUTATIONAL_12 -> (fun _ -> "COMPUTATIONAL_12") + | MenhirInterpreter.T T_COMPUTATIONAL_11 -> (fun _ -> "COMPUTATIONAL_11") + | MenhirInterpreter.T T_COMPLEMENTARY -> (fun _ -> "COMPLEMENTARY") + | MenhirInterpreter.T T_COMPLE -> (fun _ -> "COMPLE") + | MenhirInterpreter.T T_COMP -> (fun _ -> "COMP") + | MenhirInterpreter.T T_COMMUNICATION -> (fun _ -> "COMMUNICATION") + | MenhirInterpreter.T T_COMMON -> (fun _ -> "COMMON") + | MenhirInterpreter.T T_COMMIT -> (fun _ -> "COMMIT") + | MenhirInterpreter.T T_COMMAND_LINE -> (fun _ -> "COMMAND_LINE") + | MenhirInterpreter.T T_COMMA -> (fun _ -> "COMMA") + | MenhirInterpreter.T T_COMBO_BOX -> (fun _ -> "COMBO_BOX") + | MenhirInterpreter.T T_COLUMN_PROTECTION -> (fun _ -> "COLUMN_PROTECTION") + | MenhirInterpreter.T T_COLUMN_HEADINGS -> (fun _ -> "COLUMN_HEADINGS") + | MenhirInterpreter.T T_COLUMN_FONT -> (fun _ -> "COLUMN_FONT") + | MenhirInterpreter.T T_COLUMN_DIVIDERS -> (fun _ -> "COLUMN_DIVIDERS") + | MenhirInterpreter.T T_COLUMN_COLOR -> (fun _ -> "COLUMN_COLOR") + | MenhirInterpreter.T T_COLUMNS -> (fun _ -> "COLUMNS") + | MenhirInterpreter.T T_COLUMN -> (fun _ -> "COLUMN") + | MenhirInterpreter.T T_COLORS -> (fun _ -> "COLORS") + | MenhirInterpreter.T T_COLOR -> (fun _ -> "COLOR") + | MenhirInterpreter.T T_COLON -> (fun _ -> ":") + | MenhirInterpreter.T T_COLLATING -> (fun _ -> "COLLATING") + | MenhirInterpreter.T T_COL -> (fun _ -> "COL") + | MenhirInterpreter.T T_CODE_SET -> (fun _ -> "CODE_SET") + | MenhirInterpreter.T T_CODE -> (fun _ -> "CODE") + | MenhirInterpreter.T T_COBOL -> (fun _ -> "COBOL") + | MenhirInterpreter.T T_CLOSE -> (fun _ -> "CLOSE") + | MenhirInterpreter.T T_CLOCK_UNITS -> (fun _ -> "CLOCK_UNITS") + | MenhirInterpreter.T T_CLINES -> (fun _ -> "CLINES") + | MenhirInterpreter.T T_CLINE -> (fun _ -> "CLINE") + | MenhirInterpreter.T T_CLEAR_SELECTION -> (fun _ -> "CLEAR_SELECTION") + | MenhirInterpreter.T T_CLASS_ID -> (fun _ -> "CLASS_ID") + | MenhirInterpreter.T T_CLASSIFICATION -> (fun _ -> "CLASSIFICATION") + | MenhirInterpreter.T T_CLASS -> (fun _ -> "CLASS") + | MenhirInterpreter.T T_CHECK_BOX -> (fun _ -> "CHECK_BOX") + | MenhirInterpreter.T T_CHECKPOINT_FILE -> (fun _ -> "CHECKPOINT_FILE") + | MenhirInterpreter.T T_CHECK -> (fun _ -> "CHECK") + | MenhirInterpreter.T T_CHARACTERS -> (fun _ -> "CHARACTERS") + | MenhirInterpreter.T T_CHARACTER -> (fun _ -> "CHARACTER") + | MenhirInterpreter.T T_CHANGED -> (fun _ -> "CHANGED") + | MenhirInterpreter.T T_CHAINING -> (fun _ -> "CHAINING") + | MenhirInterpreter.T T_CHAIN -> (fun _ -> "CHAIN") + | MenhirInterpreter.T T_CH -> (fun _ -> "CH") + | MenhirInterpreter.T T_CF -> (fun _ -> "CF") + | MenhirInterpreter.T T_CENTURY_DATE -> (fun _ -> "CENTURY_DATE") + | MenhirInterpreter.T T_CENTERED_HEADINGS -> (fun _ -> "CENTERED_HEADINGS") + | MenhirInterpreter.T T_CENTERED -> (fun _ -> "CENTERED") + | MenhirInterpreter.T T_CENTER -> (fun _ -> "CENTER") + | MenhirInterpreter.T T_CELL_PROTECTION -> (fun _ -> "CELL_PROTECTION") + | MenhirInterpreter.T T_CELL_FONT -> (fun _ -> "CELL_FONT") + | MenhirInterpreter.T T_CELL_DATA -> (fun _ -> "CELL_DATA") + | MenhirInterpreter.T T_CELL_COLOR -> (fun _ -> "CELL_COLOR") + | MenhirInterpreter.T T_CELL -> (fun _ -> "CELL") + | MenhirInterpreter.T T_CD -> (fun _ -> "CD") + | MenhirInterpreter.T T_CCOL -> (fun _ -> "CCOL") + | MenhirInterpreter.T T_CATALOGUE_NAME -> (fun _ -> "CATALOGUE_NAME") + | MenhirInterpreter.T T_CATALOGUED -> (fun _ -> "CATALOGUED") + | MenhirInterpreter.T T_CASSETTE -> (fun _ -> "CASSETTE") + | MenhirInterpreter.T T_CARD_READER -> (fun _ -> "CARD_READER") + | MenhirInterpreter.T T_CARD_PUNCH -> (fun _ -> "CARD_PUNCH") + | MenhirInterpreter.T T_CAPACITY -> (fun _ -> "CAPACITY") + | MenhirInterpreter.T T_CANCEL_BUTTON -> (fun _ -> "CANCEL_BUTTON") + | MenhirInterpreter.T T_CANCEL -> (fun _ -> "CANCEL") + | MenhirInterpreter.T T_CALL -> (fun _ -> "CALL") + | MenhirInterpreter.T T_CALENDAR_FONT -> (fun _ -> "CALENDAR_FONT") + | MenhirInterpreter.T T_C -> (fun _ -> "C") + | MenhirInterpreter.T T_B_XOR -> (fun _ -> "B_XOR") + | MenhirInterpreter.T T_B_SHIFT_RC -> (fun _ -> "B_SHIFT_RC") + | MenhirInterpreter.T T_B_SHIFT_R -> (fun _ -> "B_SHIFT_R") + | MenhirInterpreter.T T_B_SHIFT_LC -> (fun _ -> "B_SHIFT_LC") + | MenhirInterpreter.T T_B_SHIFT_L -> (fun _ -> "B_SHIFT_L") + | MenhirInterpreter.T T_B_OR -> (fun _ -> "B_OR") + | MenhirInterpreter.T T_B_NOT -> (fun _ -> "B_NOT") + | MenhirInterpreter.T T_B_EXOR -> (fun _ -> "B_EXOR") + | MenhirInterpreter.T T_B_AND -> (fun _ -> "B_AND") + | MenhirInterpreter.T T_BYTE_LENGTH -> (fun _ -> "BYTE_LENGTH") + | MenhirInterpreter.T T_BYTES -> (fun _ -> "BYTES") + | MenhirInterpreter.T T_BYTE -> (fun _ -> "BYTE") + | MenhirInterpreter.T T_BY -> (fun _ -> "BY") + | MenhirInterpreter.T T_BUTTONS -> (fun _ -> "BUTTONS") + | MenhirInterpreter.T T_BUSY -> (fun _ -> "BUSY") + | MenhirInterpreter.T T_BULK_ADDITION -> (fun _ -> "BULK_ADDITION") + | MenhirInterpreter.T T_BSN -> (fun _ -> "BSN") + | MenhirInterpreter.T T_BOXED -> (fun _ -> "BOXED") + | MenhirInterpreter.T T_BOX -> (fun _ -> "BOX") + | MenhirInterpreter.T T_BOTTOM -> (fun _ -> "BOTTOM") + | MenhirInterpreter.T T_BOOLIT -> (fun _ -> "BOOLIT") + | MenhirInterpreter.T T_BOOLEAN -> (fun _ -> "BOOLEAN") + | MenhirInterpreter.T T_BLOCK -> (fun _ -> "BLOCK") + | MenhirInterpreter.T T_BLINK -> (fun _ -> "BLINK") + | MenhirInterpreter.T T_BLANK -> (fun _ -> "BLANK") + | MenhirInterpreter.T T_BITS -> (fun _ -> "BITS") + | MenhirInterpreter.T T_BITMAP_WIDTH -> (fun _ -> "BITMAP_WIDTH") + | MenhirInterpreter.T T_BITMAP_TRANSPARENT_COLOR -> (fun _ -> "BITMAP_TRANSPARENT_COLOR") + | MenhirInterpreter.T T_BITMAP_TRAILING -> (fun _ -> "BITMAP_TRAILING") + | MenhirInterpreter.T T_BITMAP_TIMER -> (fun _ -> "BITMAP_TIMER") + | MenhirInterpreter.T T_BITMAP_START -> (fun _ -> "BITMAP_START") + | MenhirInterpreter.T T_BITMAP_NUMBER -> (fun _ -> "BITMAP_NUMBER") + | MenhirInterpreter.T T_BITMAP_HANDLE -> (fun _ -> "BITMAP_HANDLE") + | MenhirInterpreter.T T_BITMAP_END -> (fun _ -> "BITMAP_END") + | MenhirInterpreter.T T_BITMAP -> (fun _ -> "BITMAP") + | MenhirInterpreter.T T_BIT -> (fun _ -> "BIT") + | MenhirInterpreter.T T_BINARY_SHORT -> (fun _ -> "BINARY_SHORT") + | MenhirInterpreter.T T_BINARY_SEQUENTIAL -> (fun _ -> "BINARY_SEQUENTIAL") + | MenhirInterpreter.T T_BINARY_LONG -> (fun _ -> "BINARY_LONG") + | MenhirInterpreter.T T_BINARY_ENCODING -> (fun _ -> "BINARY_ENCODING") + | MenhirInterpreter.T T_BINARY_DOUBLE -> (fun _ -> "BINARY_DOUBLE") + | MenhirInterpreter.T T_BINARY_C_LONG -> (fun _ -> "BINARY_C_LONG") + | MenhirInterpreter.T T_BINARY_CHAR -> (fun _ -> "BINARY_CHAR") + | MenhirInterpreter.T T_BINARY -> (fun _ -> "BINARY") + | MenhirInterpreter.T T_BELL -> (fun _ -> "BELL") + | MenhirInterpreter.T T_BEGINNING -> (fun _ -> "BEGINNING") + | MenhirInterpreter.T T_BEFORE -> (fun _ -> "BEFORE") + | MenhirInterpreter.T T_BECOMES -> (fun _ -> "BECOMES") + | MenhirInterpreter.T T_BASED -> (fun _ -> "BASED") + | MenhirInterpreter.T T_BAR -> (fun _ -> "BAR") + | MenhirInterpreter.T T_BACKWARD -> (fun _ -> "BACKWARD") + | MenhirInterpreter.T T_BACKGROUND_STANDARD -> (fun _ -> "BACKGROUND_STANDARD") + | MenhirInterpreter.T T_BACKGROUND_LOW -> (fun _ -> "BACKGROUND_LOW") + | MenhirInterpreter.T T_BACKGROUND_HIGH -> (fun _ -> "BACKGROUND_HIGH") + | MenhirInterpreter.T T_BACKGROUND_COLOR -> (fun _ -> "BACKGROUND_COLOR") + | MenhirInterpreter.T T_AWAY_FROM_ZERO -> (fun _ -> "AWAY_FROM_ZERO") + | MenhirInterpreter.T T_AUTO_SPIN -> (fun _ -> "AUTO_SPIN") + | MenhirInterpreter.T T_AUTO_DECIMAL -> (fun _ -> "AUTO_DECIMAL") + | MenhirInterpreter.T T_AUTOMATIC -> (fun _ -> "AUTOMATIC") + | MenhirInterpreter.T T_AUTO -> (fun _ -> "AUTO") + | MenhirInterpreter.T T_AUTHOR -> (fun _ -> "AUTHOR") + | MenhirInterpreter.T T_AT_EOP -> (fun _ -> "AT_EOP") + | MenhirInterpreter.T T_AT_END -> (fun _ -> "AT_END") + | MenhirInterpreter.T T_ATTRIBUTES -> (fun _ -> "ATTRIBUTES") + | MenhirInterpreter.T T_ATTRIBUTE -> (fun _ -> "ATTRIBUTE") + | MenhirInterpreter.T T_AT -> (fun _ -> "AT") + | MenhirInterpreter.T T_ASTERISK -> (fun _ -> "*") + | MenhirInterpreter.T T_ASSIGN -> (fun _ -> "ASSIGN") + | MenhirInterpreter.T T_ASCII -> (fun _ -> "ASCII") + | MenhirInterpreter.T T_ASCENDING -> (fun _ -> "ASCENDING") + | MenhirInterpreter.T T_ASA -> (fun _ -> "ASA") + | MenhirInterpreter.T T_AS -> (fun _ -> "AS") + | MenhirInterpreter.T T_ARITHMETIC -> (fun _ -> "ARITHMETIC") + | MenhirInterpreter.T T_ARGUMENT_VALUE -> (fun _ -> "ARGUMENT_VALUE") + | MenhirInterpreter.T T_ARGUMENT_NUMBER -> (fun _ -> "ARGUMENT_NUMBER") + | MenhirInterpreter.T T_AREAS -> (fun _ -> "AREAS") + | MenhirInterpreter.T T_AREA -> (fun _ -> "AREA") + | MenhirInterpreter.T T_ARE -> (fun _ -> "ARE") + | MenhirInterpreter.T T_APPLY -> (fun _ -> "APPLY") + | MenhirInterpreter.T T_ANYCASE -> (fun _ -> "ANYCASE") + | MenhirInterpreter.T T_ANY -> (fun _ -> "ANY") + | MenhirInterpreter.T T_ANUM -> (fun _ -> "ANUM") + | MenhirInterpreter.T T_ANSI -> (fun _ -> "ANSI") + | MenhirInterpreter.T T_AND -> (fun _ -> "AND") + | MenhirInterpreter.T T_AMPERSAND -> (fun _ -> "&") + | MenhirInterpreter.T T_ALTERNATE -> (fun _ -> "ALTERNATE") + | MenhirInterpreter.T T_ALTERING -> (fun _ -> "ALTERING") + | MenhirInterpreter.T T_ALTER -> (fun _ -> "ALTER") + | MenhirInterpreter.T T_ALSO -> (fun _ -> "ALSO") + | MenhirInterpreter.T T_ALPHANUM_PREFIX -> (fun _ -> "ALPHANUM_PREFIX") + | MenhirInterpreter.T T_ALPHANUMERIC_EDITED -> (fun _ -> "ALPHANUMERIC_EDITED") + | MenhirInterpreter.T T_ALPHANUMERIC -> (fun _ -> "ALPHANUMERIC") + | MenhirInterpreter.T T_ALPHANUM -> (fun _ -> "ALPHANUM") + | MenhirInterpreter.T T_ALPHABETIC_UPPER -> (fun _ -> "ALPHABETIC_UPPER") + | MenhirInterpreter.T T_ALPHABETIC_LOWER -> (fun _ -> "ALPHABETIC_LOWER") + | MenhirInterpreter.T T_ALPHABETIC -> (fun _ -> "ALPHABETIC") + | MenhirInterpreter.T T_ALPHABET -> (fun _ -> "ALPHABET") + | MenhirInterpreter.T T_ALLOWING -> (fun _ -> "ALLOWING") + | MenhirInterpreter.T T_ALLOCATE -> (fun _ -> "ALLOCATE") + | MenhirInterpreter.T T_ALL -> (fun _ -> "ALL") + | MenhirInterpreter.T T_ALIGNMENT -> (fun _ -> "ALIGNMENT") + | MenhirInterpreter.T T_ALIGNED -> (fun _ -> "ALIGNED") + | MenhirInterpreter.T T_ALIAS -> (fun _ -> "ALIAS") + | MenhirInterpreter.T T_AFTER -> (fun _ -> "AFTER") + | MenhirInterpreter.T T_ADVANCING -> (fun _ -> "ADVANCING") + | MenhirInterpreter.T T_ADJUSTABLE_COLUMNS -> (fun _ -> "ADJUSTABLE_COLUMNS") + | MenhirInterpreter.T T_ADDRESS -> (fun _ -> "ADDRESS") + | MenhirInterpreter.T T_ADD -> (fun _ -> "ADD") + | MenhirInterpreter.T T_ACTUAL -> (fun _ -> "ACTUAL") + | MenhirInterpreter.T T_ACTIVE_X -> (fun _ -> "ACTIVE_X") + | MenhirInterpreter.T T_ACTIVE_CLASS -> (fun _ -> "ACTIVE_CLASS") + | MenhirInterpreter.T T_ACTIVATING -> (fun _ -> "ACTIVATING") + | MenhirInterpreter.T T_ACTION -> (fun _ -> "ACTION") + | MenhirInterpreter.T T_ACCESS -> (fun _ -> "ACCESS") + | MenhirInterpreter.T T_ACCEPT -> (fun _ -> "ACCEPT") + | MenhirInterpreter.T T_ABSENT -> (fun _ -> "ABSENT") + | MenhirInterpreter.N MenhirInterpreter.N_write_target -> (fun _ -> "write_target") + | MenhirInterpreter.N MenhirInterpreter.N_write_statement -> (fun _ -> "write_statement") + | MenhirInterpreter.N MenhirInterpreter.N_working_storage_section -> (fun _ -> "working_storage_section") + | MenhirInterpreter.N MenhirInterpreter.N_word_or_terminal -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_with_test -> (fun _ -> "with_test") + | MenhirInterpreter.N MenhirInterpreter.N_with_status -> (fun _ -> "with_status") + | MenhirInterpreter.N MenhirInterpreter.N_with_no_advancing -> (fun _ -> "with_no_advancing") + | MenhirInterpreter.N MenhirInterpreter.N_with_lock_clause -> (fun _ -> "with_lock_clause") + | MenhirInterpreter.N MenhirInterpreter.N_with_lock -> (fun _ -> "with_lock") + | MenhirInterpreter.N MenhirInterpreter.N_with_key -> (fun _ -> "with_key") + | MenhirInterpreter.N MenhirInterpreter.N_with_data -> (fun _ -> "with_data") + | MenhirInterpreter.N MenhirInterpreter.N_when_selection_objects -> (fun _ -> "when_selection_objects") + | MenhirInterpreter.N MenhirInterpreter.N_when_phrase -> (fun _ -> "when_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_when_other -> (fun _ -> "when_other") + | MenhirInterpreter.N MenhirInterpreter.N_when_clause -> (fun _ -> "when_clause") + | MenhirInterpreter.N MenhirInterpreter.N_varying_phrase -> (fun _ -> "varying_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_varying_clause -> (fun _ -> "varying_clause") + | MenhirInterpreter.N MenhirInterpreter.N_value_of_clause -> (fun _ -> "value_of_clause") + | MenhirInterpreter.N MenhirInterpreter.N_validation_stage -> (fun _ -> "validation_stage") + | MenhirInterpreter.N MenhirInterpreter.N_validation_clause -> (fun _ -> "validation_clause") + | MenhirInterpreter.N MenhirInterpreter.N_validate_status_clause -> (fun _ -> "validate_status_clause") + | MenhirInterpreter.N MenhirInterpreter.N_validate_statement -> (fun _ -> "validate_statement") + | MenhirInterpreter.N MenhirInterpreter.N_using_clause -> (fun _ -> "using_clause") + | MenhirInterpreter.N MenhirInterpreter.N_using_by -> (fun _ -> "using_by") + | MenhirInterpreter.N MenhirInterpreter.N_use_statement -> (fun _ -> "use_statement") + | MenhirInterpreter.N MenhirInterpreter.N_use_after_exception -> (fun _ -> "use_after_exception") + | MenhirInterpreter.N MenhirInterpreter.N_usage_clause -> (fun _ -> "usage_clause") + | MenhirInterpreter.N MenhirInterpreter.N_usage -> (fun _ -> "usage") + | MenhirInterpreter.N MenhirInterpreter.N_upon -> (fun _ -> "upon") + | MenhirInterpreter.N MenhirInterpreter.N_up_down -> (fun _ -> "up_down") + | MenhirInterpreter.N MenhirInterpreter.N_unstring_target -> (fun _ -> "unstring_target") + | MenhirInterpreter.N MenhirInterpreter.N_unstring_statement -> (fun _ -> "unstring_statement") + | MenhirInterpreter.N MenhirInterpreter.N_unstring_delimiters -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_unlock_statement -> (fun _ -> "unlock_statement") + | MenhirInterpreter.N MenhirInterpreter.N_unconditional_action -> (fun _ -> "unconditional_action") + | MenhirInterpreter.N MenhirInterpreter.N_typedef_clause -> (fun _ -> "typedef_clause") + | MenhirInterpreter.N MenhirInterpreter.N_transform_statement -> (fun _ -> "transform_statement") + | MenhirInterpreter.N MenhirInterpreter.N_then_replacing -> (fun _ -> "then_replacing") + | MenhirInterpreter.N MenhirInterpreter.N_terminate_statement -> (fun _ -> "terminate_statement") + | MenhirInterpreter.N MenhirInterpreter.N_tallying_for -> (fun _ -> "tallying_for") + | MenhirInterpreter.N MenhirInterpreter.N_tallying -> (fun _ -> "tallying") + | MenhirInterpreter.N MenhirInterpreter.N_synchronized_clause -> (fun _ -> "synchronized_clause") + | MenhirInterpreter.N MenhirInterpreter.N_symbolic_characters_clause -> (fun _ -> "symbolic_characters_clause") + | MenhirInterpreter.N MenhirInterpreter.N_suppress_statement -> (fun _ -> "suppress_statement") + | MenhirInterpreter.N MenhirInterpreter.N_sum_phrase -> (fun _ -> "sum_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_sum_operands -> (fun _ -> "sum_operands") + | MenhirInterpreter.N MenhirInterpreter.N_sum_clause -> (fun _ -> "sum_clause") + | MenhirInterpreter.N MenhirInterpreter.N_subtract_statement -> (fun _ -> "subtract_statement") + | MenhirInterpreter.N MenhirInterpreter.N_subscripts -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_subscript_following -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_subscript_first -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_structure_kind -> (fun _ -> "structure_kind") + | MenhirInterpreter.N MenhirInterpreter.N_string_statement -> (fun _ -> "string_statement") + | MenhirInterpreter.N MenhirInterpreter.N_string_or_int_literal -> (fun _ -> "string_or_int_literal") + | MenhirInterpreter.N MenhirInterpreter.N_string_literal_no_all -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_string_literal -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_stop_statement -> (fun _ -> "stop_statement") + | MenhirInterpreter.N MenhirInterpreter.N_stop_kind -> (fun _ -> "stop_kind") + | MenhirInterpreter.N MenhirInterpreter.N_step_phrase -> (fun _ -> "step_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_status_switch -> (fun _ -> "status_switch") + | MenhirInterpreter.N MenhirInterpreter.N_start_statement -> (fun _ -> "start_statement") + | MenhirInterpreter.N MenhirInterpreter.N_standalone_condition -> (fun _ -> "standalone_condition") + | MenhirInterpreter.N MenhirInterpreter.N_specifier -> (fun _ -> "specifier") + | MenhirInterpreter.N MenhirInterpreter.N_special_names_paragraph -> (fun _ -> "special_names_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_special_names_clause -> (fun _ -> "special_names_clause") + | MenhirInterpreter.N MenhirInterpreter.N_source_string -> (fun _ -> "source_string") + | MenhirInterpreter.N MenhirInterpreter.N_source_operands -> (fun _ -> "source_operands") + | MenhirInterpreter.N MenhirInterpreter.N_source_destination_clauses -> (fun _ -> "source_destination_clauses") + | MenhirInterpreter.N MenhirInterpreter.N_source_destination_clause -> (fun _ -> "source_destination_clause") + | MenhirInterpreter.N MenhirInterpreter.N_source_computer_paragraph -> (fun _ -> "source_computer_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_source_clause -> (fun _ -> "source_clause") + | MenhirInterpreter.N MenhirInterpreter.N_sort_statement -> (fun _ -> "sort_statement") + | MenhirInterpreter.N MenhirInterpreter.N_sort_merge_file_descr_clause -> (fun _ -> "sort_merge_file_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_signedness_ -> (fun _ -> "signedness_") + | MenhirInterpreter.N MenhirInterpreter.N_sign_condition_no_zero -> (fun _ -> "sign_condition_no_zero") + | MenhirInterpreter.N MenhirInterpreter.N_sign_condition -> (fun _ -> "sign_condition") + | MenhirInterpreter.N MenhirInterpreter.N_sign_clause -> (fun _ -> "sign_clause") + | MenhirInterpreter.N MenhirInterpreter.N_sign -> (fun _ -> "sign") + | MenhirInterpreter.N MenhirInterpreter.N_sharing_phrase -> (fun _ -> "sharing_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_sharing_mode -> (fun _ -> "sharing_mode") + | MenhirInterpreter.N MenhirInterpreter.N_sharing_clause -> (fun _ -> "sharing_clause") + | MenhirInterpreter.N MenhirInterpreter.N_set_statement -> (fun _ -> "set_statement") + | MenhirInterpreter.N MenhirInterpreter.N_set_attribute_switches -> (fun _ -> "set_attribute_switches") + | MenhirInterpreter.N MenhirInterpreter.N_sentence -> (fun _ -> "sentence") + | MenhirInterpreter.N MenhirInterpreter.N_send_statement -> (fun _ -> "send_statement") + | MenhirInterpreter.N MenhirInterpreter.N_selection_subjects -> (fun _ -> "selection_subjects") + | MenhirInterpreter.N MenhirInterpreter.N_selection_subject -> (fun _ -> "selection_subject") + | MenhirInterpreter.N MenhirInterpreter.N_selection_objects -> (fun _ -> "selection_objects") + | MenhirInterpreter.N MenhirInterpreter.N_selection_object -> (fun _ -> "selection_object") + | MenhirInterpreter.N MenhirInterpreter.N_select_when_clause -> (fun _ -> "select_when_clause") + | MenhirInterpreter.N MenhirInterpreter.N_select_clause -> (fun _ -> "select_clause") + | MenhirInterpreter.N MenhirInterpreter.N_select -> (fun _ -> "select") + | MenhirInterpreter.N MenhirInterpreter.N_segment_limit_clause -> (fun _ -> "segment_limit_clause") + | MenhirInterpreter.N MenhirInterpreter.N_section_paragraphs -> (fun _ -> "section_paragraphs") + | MenhirInterpreter.N MenhirInterpreter.N_section_paragraph -> (fun _ -> "section_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_search_statement -> (fun _ -> "search_statement") + | MenhirInterpreter.N MenhirInterpreter.N_search_condition -> (fun _ -> "search_condition") + | MenhirInterpreter.N MenhirInterpreter.N_screen_section -> (fun _ -> "screen_section") + | MenhirInterpreter.N MenhirInterpreter.N_screen_occurs_clause -> (fun _ -> "screen_occurs_clause") + | MenhirInterpreter.N MenhirInterpreter.N_screen_line_column_clause -> (fun _ -> "screen_line_column_clause") + | MenhirInterpreter.N MenhirInterpreter.N_screen_line_clause -> (fun _ -> "screen_line_clause") + | MenhirInterpreter.N MenhirInterpreter.N_screen_descr_entry -> (fun _ -> "screen_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_screen_descr_clause -> (fun _ -> "screen_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_screen_column_clause -> (fun _ -> "screen_column_clause") + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_on_off -> (fun _ -> "screen_attribute_on_off") + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_name -> (fun _ -> "screen_attribute_name") + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_clauses -> (fun _ -> "screen_attribute_clauses") + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_clause -> (fun _ -> "screen_attribute_clause") + | MenhirInterpreter.N MenhirInterpreter.N_same_as_clause -> (fun _ -> "same_as_clause") + | MenhirInterpreter.N MenhirInterpreter.N_same_area_clause -> (fun _ -> "same_area_clause") + | MenhirInterpreter.N MenhirInterpreter.N_s_delimited_by -> (fun _ -> "s_delimited_by") + | MenhirInterpreter.N MenhirInterpreter.N_rounding_mode -> (fun _ -> "rounding_mode") + | MenhirInterpreter.N MenhirInterpreter.N_rounded_phrase_opt -> (fun _ -> "rounded_phrase_opt") + | MenhirInterpreter.N MenhirInterpreter.N_rounded_phrase -> (fun _ -> "rounded_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_rounded_ident -> (fun _ -> "rounded_ident") + | MenhirInterpreter.N MenhirInterpreter.N_rounded_clause -> (fun _ -> "rounded_clause") + | MenhirInterpreter.N MenhirInterpreter.N_ro_working_storage_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_with_test_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_with_status_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_step_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_special_names_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_source_computer_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_signedness_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_sign_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_sharing_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_screen_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_s_delimited_by_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_returning_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_retry_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_repository_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_report_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_read_direction_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_raising_exception_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_procedure_division_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_picture_locale_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_option_TO__name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_86_qualname__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_44_property_kind__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_43_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_38_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_37_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_34_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_33_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_32_qualname_or_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_30_qualname_or_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_14_string_literal__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_101_ident__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_100_ident__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_VARYING_ident__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_USING_name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_TO_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_string_or_int_literal__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_qualified_procedure_name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_procedure_name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_REMAINDER_ident__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_POSITION_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_ON_name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_INTO_loc_ident___ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_INTO_ident__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_IN_name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_integer__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_ident_or_literal__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_expression__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_BY_ident_or_numeric__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_BY_expression__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_AS_string_literal__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_perform_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_options_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_object_reference_kind_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_object_procedure_division_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_object_computer_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_name_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_lock_or_retry_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_locale_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_local_storage_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_upon__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_program_procedure_division__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_procedure_division__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_environment_division__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_entry_name_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_data_division__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_linkage_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_io_control_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_integer_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_instance_definition_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_input_output_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_identification_division_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_file_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_file_control_paragraph_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_expression_no_all_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_expands_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_endianness_mode_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_depending_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_configuration_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_communication_section_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_collating_sequence_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_close_format_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_capacity_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ro_advancing_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev_tallying_ -> (fun _ -> "rnell_rev_tallying_") + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_91_ -> (fun _ -> "rnell_rev___anonymous_91_") + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_90_ -> (fun _ -> "rnell_rev___anonymous_90_") + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_89_ -> (fun _ -> "rnell_rev___anonymous_89_") + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_88_ -> (fun _ -> "rnell_rev___anonymous_88_") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_when_selection_objects_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_validation_stage_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_use_after_exception_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_unstring_target_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_subscript_following_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_specifier_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_screen_attribute_on_off_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_rounded_ident_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_qualname_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_qualified_procedure_name_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_pf_ALSO_string_or_int_literal__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_open_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_on_key_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_name_or_alphanum_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_name_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_using_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_using_by__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_tallying_for__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_special_names_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_sentence__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_select_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_section_paragraph__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_replacing_phrase__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_options_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_decl_section_paragraph__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_through_literal_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_line_position_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_integer_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_string_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_numeric_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_literal_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_by_after_before_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_file_with_opt_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_debug_target_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_column_position_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rnel_argument_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_select_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_pf_FILE_name__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_name_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_result_imperative_statement__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_sort_merge_file_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_sentence__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_section_paragraph__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_screen_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_same_area_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_rerun_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_group_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_descr_entry__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_object_computer_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_multiple_file_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_method_definition__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_file_or_sort_merge_descr_entry__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_file_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_entry_name_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_data_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_screen_descr_entry__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_report_group_descr_entry__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_data_descr_entry__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_communication_descr_entry__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_communication_descr_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_key_is_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rl_inspect_where_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_rewrite_statement -> (fun _ -> "rewrite_statement") + | MenhirInterpreter.N MenhirInterpreter.N_reversed_or_no_rewind_opt -> (fun _ -> "reversed_or_no_rewind_opt") + | MenhirInterpreter.N MenhirInterpreter.N_returning -> (fun _ -> "returning") + | MenhirInterpreter.N MenhirInterpreter.N_return_statement -> (fun _ -> "return_statement") + | MenhirInterpreter.N MenhirInterpreter.N_retry_phrase -> (fun _ -> "retry_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_resume_statement -> (fun _ -> "resume_statement") + | MenhirInterpreter.N MenhirInterpreter.N_reserve_clause -> (fun _ -> "reserve_clause") + | MenhirInterpreter.N MenhirInterpreter.N_rerun_frequency -> (fun _ -> "rerun_frequency") + | MenhirInterpreter.N MenhirInterpreter.N_rerun_clause -> (fun _ -> "rerun_clause") + | MenhirInterpreter.N MenhirInterpreter.N_repository_paragraph -> (fun _ -> "repository_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_report_value_clause -> (fun _ -> "report_value_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_type_clause -> (fun _ -> "report_type_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_section -> (fun _ -> "report_section") + | MenhirInterpreter.N MenhirInterpreter.N_report_screen_usage_clause -> (fun _ -> "report_screen_usage_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_occurs_clause -> (fun _ -> "report_occurs_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_line_clause -> (fun _ -> "report_line_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_group_descr_entry -> (fun _ -> "report_group_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_report_group_descr_clause -> (fun _ -> "report_group_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_descr_entry -> (fun _ -> "report_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_report_descr_clause -> (fun _ -> "report_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_data_name_or_final -> (fun _ -> "report_data_name_or_final") + | MenhirInterpreter.N MenhirInterpreter.N_report_column_clause -> (fun _ -> "report_column_clause") + | MenhirInterpreter.N MenhirInterpreter.N_report_clause -> (fun _ -> "report_clause") + | MenhirInterpreter.N MenhirInterpreter.N_replacing_phrase -> (fun _ -> "replacing_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_relop -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_release_statement -> (fun _ -> "release_statement") + | MenhirInterpreter.N MenhirInterpreter.N_relative_key_clause -> (fun _ -> "relative_key_clause") + | MenhirInterpreter.N MenhirInterpreter.N_relation_condition -> (fun _ -> "relation_condition") + | MenhirInterpreter.N MenhirInterpreter.N_redefines_clause -> (fun _ -> "redefines_clause") + | MenhirInterpreter.N MenhirInterpreter.N_record_key_clause -> (fun _ -> "record_key_clause") + | MenhirInterpreter.N MenhirInterpreter.N_record_delimiter_clause -> (fun _ -> "record_delimiter_clause") + | MenhirInterpreter.N MenhirInterpreter.N_record_delimiter -> (fun _ -> "record_delimiter") + | MenhirInterpreter.N MenhirInterpreter.N_record_clause -> (fun _ -> "record_clause") + | MenhirInterpreter.N MenhirInterpreter.N_receive_statement -> (fun _ -> "receive_statement") + | MenhirInterpreter.N MenhirInterpreter.N_read_statement -> (fun _ -> "read_statement") + | MenhirInterpreter.N MenhirInterpreter.N_read_direction -> (fun _ -> "read_direction") + | MenhirInterpreter.N MenhirInterpreter.N_range_expression -> (fun _ -> "range_expression") + | MenhirInterpreter.N MenhirInterpreter.N_raising_phrase -> (fun _ -> "raising_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_raising_exception -> (fun _ -> "raising_exception") + | MenhirInterpreter.N MenhirInterpreter.N_raise_statement -> (fun _ -> "raise_statement") + | MenhirInterpreter.N MenhirInterpreter.N_qualnames -> (fun _ -> "qualnames") + | MenhirInterpreter.N MenhirInterpreter.N_qualname_or_literal -> (fun _ -> "qualname_or_literal") + | MenhirInterpreter.N MenhirInterpreter.N_qualname_or_integer -> (fun _ -> "qualname_or_integer") + | MenhirInterpreter.N MenhirInterpreter.N_qualname_or_alphanum -> (fun _ -> "qualname_or_alphanum") + | MenhirInterpreter.N MenhirInterpreter.N_qualname -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_qualified_procedure_name -> (fun _ -> "qualified_procedure_name") + | MenhirInterpreter.N MenhirInterpreter.N_qualident_refmod -> (fun _ -> "qualident_refmod") + | MenhirInterpreter.N MenhirInterpreter.N_qualident_no_refmod -> (fun _ -> "qualident_no_refmod") + | MenhirInterpreter.N MenhirInterpreter.N_qualident -> (fun _ -> "<(qualified) identifier>") + | MenhirInterpreter.N MenhirInterpreter.N_purge_statement -> (fun _ -> "purge_statement") + | MenhirInterpreter.N MenhirInterpreter.N_property_clause -> (fun _ -> "property_clause") + | MenhirInterpreter.N MenhirInterpreter.N_program_prototype_id_paragraph -> (fun _ -> "program_prototype_id_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_program_prototype -> (fun _ -> "program_prototype") + | MenhirInterpreter.N MenhirInterpreter.N_program_procedure_division -> (fun _ -> "program_procedure_division") + | MenhirInterpreter.N MenhirInterpreter.N_program_kind -> (fun _ -> "program_kind") + | MenhirInterpreter.N MenhirInterpreter.N_program_id_paragraph -> (fun _ -> "program_id_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_program_definition_no_end -> (fun _ -> "program_definition_no_end") + | MenhirInterpreter.N MenhirInterpreter.N_program_definition -> (fun _ -> "program_definition") + | MenhirInterpreter.N MenhirInterpreter.N_program_collating_sequence_clause -> (fun _ -> "program_collating_sequence_clause") + | MenhirInterpreter.N MenhirInterpreter.N_procedure_name_decl -> (fun _ -> "procedure_name_decl") + | MenhirInterpreter.N MenhirInterpreter.N_procedure_name -> (fun _ -> "procedure_name") + | MenhirInterpreter.N MenhirInterpreter.N_procedure_division -> (fun _ -> "procedure_division") + | MenhirInterpreter.N MenhirInterpreter.N_present_when_clause -> (fun _ -> "present_when_clause") + | MenhirInterpreter.N MenhirInterpreter.N_position -> (fun _ -> "position") + | MenhirInterpreter.N MenhirInterpreter.N_plus_or_minus -> (fun _ -> "plus_or_minus") + | MenhirInterpreter.N MenhirInterpreter.N_picture_locale_phrase -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_picture_clause -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_perform_statement -> (fun _ -> "perform_statement") + | MenhirInterpreter.N MenhirInterpreter.N_perform_phrase -> (fun _ -> "perform_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_partial_expression -> (fun _ -> "partial_expression") + | MenhirInterpreter.N MenhirInterpreter.N_page_line_col -> (fun _ -> "page_line_col") + | MenhirInterpreter.N MenhirInterpreter.N_page_limit_clause -> (fun _ -> "page_limit_clause") + | MenhirInterpreter.N MenhirInterpreter.N_padding_character_clause -> (fun _ -> "padding_character_clause") + | MenhirInterpreter.N MenhirInterpreter.N_output_or_giving -> (fun _ -> "output_or_giving") + | MenhirInterpreter.N MenhirInterpreter.N_organization_clause -> (fun _ -> "organization_clause") + | MenhirInterpreter.N MenhirInterpreter.N_organization -> (fun _ -> "organization") + | MenhirInterpreter.N MenhirInterpreter.N_order_table_clause -> (fun _ -> "order_table_clause") + | MenhirInterpreter.N MenhirInterpreter.N_options_paragraph -> (fun _ -> "options_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_options_clause -> (fun _ -> "options_clause") + | MenhirInterpreter.N MenhirInterpreter.N_optional_arguments_list -> (fun _ -> "optional_arguments_list") + | MenhirInterpreter.N MenhirInterpreter.N_option_working_storage_section_ -> (fun _ -> "option_working_storage_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_with_test_ -> (fun _ -> "option_with_test_") + | MenhirInterpreter.N MenhirInterpreter.N_option_with_status_ -> (fun _ -> "option_with_status_") + | MenhirInterpreter.N MenhirInterpreter.N_option_step_phrase_ -> (fun _ -> "option_step_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_special_names_paragraph_ -> (fun _ -> "option_special_names_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_source_computer_paragraph_ -> (fun _ -> "option_source_computer_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_signedness_ -> (fun _ -> "option_signedness_") + | MenhirInterpreter.N MenhirInterpreter.N_option_sign_ -> (fun _ -> "option_sign_") + | MenhirInterpreter.N MenhirInterpreter.N_option_sharing_phrase_ -> (fun _ -> "option_sharing_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_screen_section_ -> (fun _ -> "option_screen_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_s_delimited_by_ -> (fun _ -> "option_s_delimited_by_") + | MenhirInterpreter.N MenhirInterpreter.N_option_returning_ -> (fun _ -> "option_returning_") + | MenhirInterpreter.N MenhirInterpreter.N_option_retry_phrase_ -> (fun _ -> "option_retry_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_repository_paragraph_ -> (fun _ -> "option_repository_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_report_section_ -> (fun _ -> "option_report_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_read_direction_ -> (fun _ -> "option_read_direction_") + | MenhirInterpreter.N MenhirInterpreter.N_option_raising_exception_ -> (fun _ -> "option_raising_exception_") + | MenhirInterpreter.N MenhirInterpreter.N_option_procedure_division_ -> (fun _ -> "option_procedure_division_") + | MenhirInterpreter.N MenhirInterpreter.N_option_picture_locale_phrase_ -> (fun _ -> "option_picture_locale_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_option_TO__name__ -> (fun _ -> "option_pf_option_TO__name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_option_IS__name__ -> (fun _ -> "option_pf_option_IS__name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_86_qualname__ -> (fun _ -> "option_pf___anonymous_86_qualname__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_44_property_kind__ -> (fun _ -> "option_pf___anonymous_44_property_kind__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_43_integer__ -> (fun _ -> "option_pf___anonymous_43_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_38_integer__ -> (fun _ -> "option_pf___anonymous_38_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_37_integer__ -> (fun _ -> "option_pf___anonymous_37_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_34_integer__ -> (fun _ -> "option_pf___anonymous_34_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_33_integer__ -> (fun _ -> "option_pf___anonymous_33_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_32_qualname_or_integer__ -> (fun _ -> "option_pf___anonymous_32_qualname_or_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_30_qualname_or_integer__ -> (fun _ -> "option_pf___anonymous_30_qualname_or_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_14_string_literal__ -> (fun _ -> "option_pf___anonymous_14_string_literal__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_101_ident__ -> (fun _ -> "option_pf___anonymous_101_ident__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_100_ident__ -> (fun _ -> "option_pf___anonymous_100_ident__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_VARYING_ident__ -> (fun _ -> "option_pf_VARYING_ident__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_USING_name__ -> (fun _ -> "option_pf_USING_name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_TO_integer__ -> (fun _ -> "option_pf_TO_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_string_or_int_literal__ -> (fun _ -> "option_pf_THROUGH_string_or_int_literal__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_qualified_procedure_name__ -> (fun _ -> "option_pf_THROUGH_qualified_procedure_name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_procedure_name__ -> (fun _ -> "option_pf_THROUGH_procedure_name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_REMAINDER_ident__ -> (fun _ -> "option_pf_REMAINDER_ident__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_POSITION_integer__ -> (fun _ -> "option_pf_POSITION_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_ON_name__ -> (fun _ -> "option_pf_ON_name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_INTO_loc_ident___ -> (fun _ -> "option_pf_INTO_loc_ident___") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_INTO_ident__ -> (fun _ -> "option_pf_INTO_ident__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_IN_name__ -> (fun _ -> "option_pf_IN_name__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_integer__ -> (fun _ -> "option_pf_FROM_integer__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_ident_or_literal__ -> (fun _ -> "option_pf_FROM_ident_or_literal__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_expression__ -> (fun _ -> "option_pf_FROM_expression__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_BY_ident_or_numeric__ -> (fun _ -> "option_pf_BY_ident_or_numeric__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_BY_expression__ -> (fun _ -> "option_pf_BY_expression__") + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_AS_string_literal__ -> (fun _ -> "option_pf_AS_string_literal__") + | MenhirInterpreter.N MenhirInterpreter.N_option_perform_phrase_ -> (fun _ -> "option_perform_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_or__NUMBER_NUMBERS__ -> (fun _ -> "option_or__NUMBER_NUMBERS__") + | MenhirInterpreter.N MenhirInterpreter.N_option_or__LINE_LINES__ -> (fun _ -> "option_or__LINE_LINES__") + | MenhirInterpreter.N MenhirInterpreter.N_option_or__IS_ARE__ -> (fun _ -> "option_or__IS_ARE__") + | MenhirInterpreter.N MenhirInterpreter.N_option_or__AREA_AREAS__ -> (fun _ -> "option_or__AREA_AREAS__") + | MenhirInterpreter.N MenhirInterpreter.N_option_options_paragraph_ -> (fun _ -> "option_options_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_object_reference_kind_ -> (fun _ -> "option_object_reference_kind_") + | MenhirInterpreter.N MenhirInterpreter.N_option_object_procedure_division_ -> (fun _ -> "option_object_procedure_division_") + | MenhirInterpreter.N MenhirInterpreter.N_option_object_computer_paragraph_ -> (fun _ -> "option_object_computer_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_name_ -> (fun _ -> "option_name_") + | MenhirInterpreter.N MenhirInterpreter.N_option_mr___anonymous_0__ -> (fun _ -> "option_mr___anonymous_0__") + | MenhirInterpreter.N MenhirInterpreter.N_option_lock_or_retry_ -> (fun _ -> "option_lock_or_retry_") + | MenhirInterpreter.N MenhirInterpreter.N_option_locale_phrase_ -> (fun _ -> "option_locale_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_local_storage_section_ -> (fun _ -> "option_local_storage_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_upon__ -> (fun _ -> "option_loc_upon__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_program_procedure_division__ -> (fun _ -> "option_loc_program_procedure_division__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_program_definition_no_end__ -> (fun _ -> "option_loc_program_definition_no_end__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_procedure_division__ -> (fun _ -> "option_loc_procedure_division__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_environment_division__ -> (fun _ -> "option_loc_environment_division__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_entry_name_clause__ -> (fun _ -> "option_loc_entry_name_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_data_division__ -> (fun _ -> "option_loc_data_division__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_SECURITY__ -> (fun _ -> "option_loc_SECURITY__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_INSTALLATION__ -> (fun _ -> "option_loc_INSTALLATION__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_DATE_WRITTEN__ -> (fun _ -> "option_loc_DATE_WRITTEN__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_DATE_COMPILED__ -> (fun _ -> "option_loc_DATE_COMPILED__") + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_AUTHOR__ -> (fun _ -> "option_loc_AUTHOR__") + | MenhirInterpreter.N MenhirInterpreter.N_option_linkage_section_ -> (fun _ -> "option_linkage_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_limit_is__ -> (fun _ -> "option_limit_is__") + | MenhirInterpreter.N MenhirInterpreter.N_option_io_control_paragraph_ -> (fun _ -> "option_io_control_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_io_control_entry_ -> (fun _ -> "option_io_control_entry_") + | MenhirInterpreter.N MenhirInterpreter.N_option_integer_ -> (fun _ -> "option_integer_") + | MenhirInterpreter.N MenhirInterpreter.N_option_instance_definition_ -> (fun _ -> "option_instance_definition_") + | MenhirInterpreter.N MenhirInterpreter.N_option_input_output_section_ -> (fun _ -> "option_input_output_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_identification_division_ -> (fun _ -> "option_identification_division_") + | MenhirInterpreter.N MenhirInterpreter.N_option_file_section_ -> (fun _ -> "option_file_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_file_control_paragraph_ -> (fun _ -> "option_file_control_paragraph_") + | MenhirInterpreter.N MenhirInterpreter.N_option_expression_no_all_ -> (fun _ -> "option_expression_no_all_") + | MenhirInterpreter.N MenhirInterpreter.N_option_expands_phrase_ -> (fun _ -> "option_expands_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_endianness_mode_ -> (fun _ -> "option_endianness_mode_") + | MenhirInterpreter.N MenhirInterpreter.N_option_depending_phrase_ -> (fun _ -> "option_depending_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_default_section_ -> (fun _ -> "option_default_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_default_display_clause_ -> (fun _ -> "option_default_display_clause_") + | MenhirInterpreter.N MenhirInterpreter.N_option_default_accept_clause_ -> (fun _ -> "option_default_accept_clause_") + | MenhirInterpreter.N MenhirInterpreter.N_option_control_division_ -> (fun _ -> "option_control_division_") + | MenhirInterpreter.N MenhirInterpreter.N_option_configuration_section_ -> (fun _ -> "option_configuration_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_communication_section_ -> (fun _ -> "option_communication_section_") + | MenhirInterpreter.N MenhirInterpreter.N_option_collating_sequence_phrase_ -> (fun _ -> "option_collating_sequence_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_close_format_ -> (fun _ -> "option_close_format_") + | MenhirInterpreter.N MenhirInterpreter.N_option_capacity_phrase_ -> (fun _ -> "option_capacity_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option_call_using_by_ -> (fun _ -> "option_call_using_by_") + | MenhirInterpreter.N MenhirInterpreter.N_option_advancing_phrase_ -> (fun _ -> "option_advancing_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_option__assign_external__ -> (fun _ -> "option__assign_external__") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_78_ -> (fun _ -> "option___anonymous_78_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_74_ -> (fun _ -> "option___anonymous_74_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_73_ -> (fun _ -> "option___anonymous_73_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_59_ -> (fun _ -> "option___anonymous_59_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_57_ -> (fun _ -> "option___anonymous_57_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_39_ -> (fun _ -> "option___anonymous_39_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_25_ -> (fun _ -> "option___anonymous_25_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_24_ -> (fun _ -> "option___anonymous_24_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_22_ -> (fun _ -> "option___anonymous_22_") + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_1_ -> (fun _ -> "option___anonymous_1_") + | MenhirInterpreter.N MenhirInterpreter.N_option_WITH_ -> (fun _ -> "option_WITH_") + | MenhirInterpreter.N MenhirInterpreter.N_option_WHEN_ -> (fun _ -> "option_WHEN_") + | MenhirInterpreter.N MenhirInterpreter.N_option_TO_ -> (fun _ -> "option_TO_") + | MenhirInterpreter.N MenhirInterpreter.N_option_TIMES_ -> (fun _ -> "option_TIMES_") + | MenhirInterpreter.N MenhirInterpreter.N_option_THEN_ -> (fun _ -> "option_THEN_") + | MenhirInterpreter.N MenhirInterpreter.N_option_THAN_ -> (fun _ -> "option_THAN_") + | MenhirInterpreter.N MenhirInterpreter.N_option_TERMINAL_ -> (fun _ -> "option_TERMINAL_") + | MenhirInterpreter.N MenhirInterpreter.N_option_TAPE_ -> (fun _ -> "option_TAPE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_SYMBOLIC_ -> (fun _ -> "option_SYMBOLIC_") + | MenhirInterpreter.N MenhirInterpreter.N_option_STRUCTURE_ -> (fun _ -> "option_STRUCTURE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_STATUS_ -> (fun _ -> "option_STATUS_") + | MenhirInterpreter.N MenhirInterpreter.N_option_SIZE_ -> (fun _ -> "option_SIZE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_SIGN_ -> (fun _ -> "option_SIGN_") + | MenhirInterpreter.N MenhirInterpreter.N_option_SET_ -> (fun _ -> "option_SET_") + | MenhirInterpreter.N MenhirInterpreter.N_option_RIGHT_ -> (fun _ -> "option_RIGHT_") + | MenhirInterpreter.N MenhirInterpreter.N_option_REFERENCES_ -> (fun _ -> "option_REFERENCES_") + | MenhirInterpreter.N MenhirInterpreter.N_option_RECORD_ -> (fun _ -> "option_RECORD_") + | MenhirInterpreter.N MenhirInterpreter.N_option_PROGRAM_ -> (fun _ -> "option_PROGRAM_") + | MenhirInterpreter.N MenhirInterpreter.N_option_PROCEDURE_ -> (fun _ -> "option_PROCEDURE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_PRINTING_ -> (fun _ -> "option_PRINTING_") + | MenhirInterpreter.N MenhirInterpreter.N_option_PERIOD_ -> (fun _ -> "option_PERIOD_") + | MenhirInterpreter.N MenhirInterpreter.N_option_OTHER_ -> (fun _ -> "option_OTHER_") + | MenhirInterpreter.N MenhirInterpreter.N_option_ORDER_ -> (fun _ -> "option_ORDER_") + | MenhirInterpreter.N MenhirInterpreter.N_option_ON_ -> (fun _ -> "option_ON_") + | MenhirInterpreter.N MenhirInterpreter.N_option_OF_ -> (fun _ -> "option_OF_") + | MenhirInterpreter.N MenhirInterpreter.N_option_NUMBER_ -> (fun _ -> "option_NUMBER_") + | MenhirInterpreter.N MenhirInterpreter.N_option_MODE_ -> (fun _ -> "option_MODE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_MESSAGE_ -> (fun _ -> "option_MESSAGE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_LINES_ -> (fun _ -> "option_LINES_") + | MenhirInterpreter.N MenhirInterpreter.N_option_LINE_ -> (fun _ -> "option_LINE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_LENGTH_ -> (fun _ -> "option_LENGTH_") + | MenhirInterpreter.N MenhirInterpreter.N_option_LEFT_ -> (fun _ -> "option_LEFT_") + | MenhirInterpreter.N MenhirInterpreter.N_option_KEY_ -> (fun _ -> "option_KEY_") + | MenhirInterpreter.N MenhirInterpreter.N_option_IS_ -> (fun _ -> "option_IS_") + | MenhirInterpreter.N MenhirInterpreter.N_option_INITIAL_ -> (fun _ -> "option_INITIAL_") + | MenhirInterpreter.N MenhirInterpreter.N_option_INDICATE_ -> (fun _ -> "option_INDICATE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_IN_ -> (fun _ -> "option_IN_") + | MenhirInterpreter.N MenhirInterpreter.N_option_FROM_ -> (fun _ -> "option_FROM_") + | MenhirInterpreter.N MenhirInterpreter.N_option_FOR_ -> (fun _ -> "option_FOR_") + | MenhirInterpreter.N MenhirInterpreter.N_option_FILE_ -> (fun _ -> "option_FILE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_EVERY_ -> (fun _ -> "option_EVERY_") + | MenhirInterpreter.N MenhirInterpreter.N_option_END_ -> (fun _ -> "option_END_") + | MenhirInterpreter.N MenhirInterpreter.N_option_DEFAULT_ -> (fun _ -> "option_DEFAULT_") + | MenhirInterpreter.N MenhirInterpreter.N_option_DATA_ -> (fun _ -> "option_DATA_") + | MenhirInterpreter.N MenhirInterpreter.N_option_CONTAINS_ -> (fun _ -> "option_CONTAINS_") + | MenhirInterpreter.N MenhirInterpreter.N_option_COLLATING_ -> (fun _ -> "option_COLLATING_") + | MenhirInterpreter.N MenhirInterpreter.N_option_CHARACTERS_ -> (fun _ -> "option_CHARACTERS_") + | MenhirInterpreter.N MenhirInterpreter.N_option_CHARACTER_ -> (fun _ -> "option_CHARACTER_") + | MenhirInterpreter.N MenhirInterpreter.N_option_BY_ -> (fun _ -> "option_BY_") + | MenhirInterpreter.N MenhirInterpreter.N_option_AT_ -> (fun _ -> "option_AT_") + | MenhirInterpreter.N MenhirInterpreter.N_option_AREA_ -> (fun _ -> "option_AREA_") + | MenhirInterpreter.N MenhirInterpreter.N_option_ARE_ -> (fun _ -> "option_ARE_") + | MenhirInterpreter.N MenhirInterpreter.N_option_ADVANCING_ -> (fun _ -> "option_ADVANCING_") + | MenhirInterpreter.N MenhirInterpreter.N_open_statement -> (fun _ -> "open_statement") + | MenhirInterpreter.N MenhirInterpreter.N_open_phrase -> (fun _ -> "open_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_open_mode -> (fun _ -> "open_mode") + | MenhirInterpreter.N MenhirInterpreter.N_on_overflow -> (fun _ -> "on_overflow") + | MenhirInterpreter.N MenhirInterpreter.N_on_or_off -> (fun _ -> "on_or_off") + | MenhirInterpreter.N MenhirInterpreter.N_on_key -> (fun _ -> "on_key") + | MenhirInterpreter.N MenhirInterpreter.N_on_exception -> (fun _ -> "on_exception") + | MenhirInterpreter.N MenhirInterpreter.N_occurs_fixed_clause -> (fun _ -> "occurs_fixed_clause") + | MenhirInterpreter.N MenhirInterpreter.N_occurs_dynamic_clause -> (fun _ -> "occurs_dynamic_clause") + | MenhirInterpreter.N MenhirInterpreter.N_occurs_depending_clause -> (fun _ -> "occurs_depending_clause") + | MenhirInterpreter.N MenhirInterpreter.N_object_view -> (fun _ -> "object_view") + | MenhirInterpreter.N MenhirInterpreter.N_object_reference_kind -> (fun _ -> "object_reference_kind") + | MenhirInterpreter.N MenhirInterpreter.N_object_ref -> (fun _ -> "object_ref") + | MenhirInterpreter.N MenhirInterpreter.N_object_procedure_division -> (fun _ -> "object_procedure_division") + | MenhirInterpreter.N MenhirInterpreter.N_object_paragraph -> (fun _ -> "object_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_object_computer_paragraph -> (fun _ -> "object_computer_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_object_computer_clause -> (fun _ -> "object_computer_clause") + | MenhirInterpreter.N MenhirInterpreter.N_numeric_literal -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ntl_name_ -> (fun _ -> "ntl_name_") + | MenhirInterpreter.N MenhirInterpreter.N_ntl_arithmetic_term_ -> (fun _ -> "ntl_arithmetic_term_") + | MenhirInterpreter.N MenhirInterpreter.N_nonrel_condition -> (fun _ -> "nonrel_condition") + | MenhirInterpreter.N MenhirInterpreter.N_nonnumeric_literal_no_all -> (fun _ -> "nonnumeric_literal_no_all") + | MenhirInterpreter.N MenhirInterpreter.N_nonnumeric_literal -> (fun _ -> "nonnumeric_literal") + | MenhirInterpreter.N MenhirInterpreter.N_next_group_clause -> (fun _ -> "next_group_clause") + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_when_phrase_ -> (fun _ -> "nell_rev_when_phrase_") + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_source_string_ -> (fun _ -> "nell_rev_source_string_") + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_name_ -> (fun _ -> "nell_rev_name_") + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_loc_result_imperative_statement__ -> (fun _ -> "nell_rev_loc_result_imperative_statement__") + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_loc_when_clause__ -> (fun _ -> "nell_rev_loc_when_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev___anonymous_70_ -> (fun _ -> "nell_rev___anonymous_70_") + | MenhirInterpreter.N MenhirInterpreter.N_nel_when_selection_objects_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_validation_stage_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_use_after_exception_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_unstring_target_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_sum_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_subscript_following_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_specifier_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_screen_attribute_on_off_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_rounded_ident_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_qualname_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_qualified_procedure_name_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_pf_ALSO_string_or_int_literal__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_open_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_on_key_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_name_or_alphanum_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_name_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_using_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_using_by__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_tallying_for__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_special_names_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_source_destination_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_sentence__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_select_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_section_paragraph__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_screen_attribute_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_replacing_phrase__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_options_clause__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_decl_section_paragraph__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc___anonymous_72__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_literal_through_literal_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_literal_phrase_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_literal_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_line_position_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_integer_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_string_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_numeric_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_literal_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_by_after_before_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_file_with_opt_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_debug_target_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_column_position_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel_argument_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_84_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_80_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_50_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_48_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_42_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_29_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_21_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_16_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_13_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_names_or_open_mode -> (fun _ -> "names_or_open_mode") + | MenhirInterpreter.N MenhirInterpreter.N_names -> (fun _ -> "names") + | MenhirInterpreter.N MenhirInterpreter.N_name_or_string -> (fun _ -> "name_or_string") + | MenhirInterpreter.N MenhirInterpreter.N_name_or_alphanum -> (fun _ -> "name_or_alphanum") + | MenhirInterpreter.N MenhirInterpreter.N_name -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_multiply_statement -> (fun _ -> "multiply_statement") + | MenhirInterpreter.N MenhirInterpreter.N_multiple_file_clause -> (fun _ -> "multiple_file_clause") + | MenhirInterpreter.N MenhirInterpreter.N_move_statement -> (fun _ -> "move_statement") + | MenhirInterpreter.N MenhirInterpreter.N_mnemonic_name_suffix -> (fun _ -> "mnemonic_name_suffix") + | MenhirInterpreter.N MenhirInterpreter.N_mnemonic_name_clause -> (fun _ -> "mnemonic_name_clause") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_85_ -> (fun _ -> "midrule___anonymous_85_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_77_ -> (fun _ -> "midrule___anonymous_77_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_on_overflow_NOT_ON_OVERFLOW__ -> (fun _ -> "midrule___anonymous_76_on_overflow_NOT_ON_OVERFLOW__") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_on_exception_NOT_ON_EXCEPTION__ -> (fun _ -> "midrule___anonymous_76_on_exception_NOT_ON_EXCEPTION__") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_at_eop_NOT_AT_EOP__ -> (fun _ -> "midrule___anonymous_76_at_eop_NOT_AT_EOP__") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_at_end_NOT_AT_END__ -> (fun _ -> "midrule___anonymous_76_at_end_NOT_AT_END__") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_ON_SIZE_ERROR_NOT_ON_SIZE_ERROR__ -> (fun _ -> "midrule___anonymous_76_ON_SIZE_ERROR_NOT_ON_SIZE_ERROR__") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_INVALID_KEY_NOT_INVALID_KEY__ -> (fun _ -> "midrule___anonymous_76_INVALID_KEY_NOT_INVALID_KEY__") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_68_ -> (fun _ -> "midrule___anonymous_68_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_67_ -> (fun _ -> "midrule___anonymous_67_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_66_ -> (fun _ -> "midrule___anonymous_66_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_65_ -> (fun _ -> "midrule___anonymous_65_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_64_ -> (fun _ -> "midrule___anonymous_64_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_62_ -> (fun _ -> "midrule___anonymous_62_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_61_ -> (fun _ -> "midrule___anonymous_61_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_58_ -> (fun _ -> "midrule___anonymous_58_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_55_ -> (fun _ -> "midrule___anonymous_55_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_54_ -> (fun _ -> "midrule___anonymous_54_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_53_ -> (fun _ -> "midrule___anonymous_53_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_52_ -> (fun _ -> "midrule___anonymous_52_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_51_ -> (fun _ -> "midrule___anonymous_51_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_40_ -> (fun _ -> "midrule___anonymous_40_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_35_ -> (fun _ -> "midrule___anonymous_35_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_28_ -> (fun _ -> "midrule___anonymous_28_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_27_ -> (fun _ -> "midrule___anonymous_27_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_15_ -> (fun _ -> "midrule___anonymous_15_") + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_0_ -> (fun _ -> "midrule___anonymous_0_") + | MenhirInterpreter.N MenhirInterpreter.N_method_id_paragraph -> (fun _ -> "method_id_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_method_definition -> (fun _ -> "method_definition") + | MenhirInterpreter.N MenhirInterpreter.N_message_or_segment -> (fun _ -> "message_or_segment") + | MenhirInterpreter.N MenhirInterpreter.N_merge_statement -> (fun _ -> "merge_statement") + | MenhirInterpreter.N MenhirInterpreter.N_memory_size_unit -> (fun _ -> "memory_size_unit") + | MenhirInterpreter.N MenhirInterpreter.N_memory_size_clause -> (fun _ -> "memory_size_clause") + | MenhirInterpreter.N MenhirInterpreter.N_mcs_kind -> (fun _ -> "mcs_kind") + | MenhirInterpreter.N MenhirInterpreter.N_mcs_command -> (fun _ -> "mcs_command") + | MenhirInterpreter.N MenhirInterpreter.N_loption_sf_rnel_loc_options_clause___PERIOD__ -> (fun _ -> "loption_sf_rnel_loc_options_clause___PERIOD__") + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_26_nel_name___ -> (fun _ -> "loption_pf___anonymous_26_nel_name___") + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_20_names__ -> (fun _ -> "loption_pf___anonymous_20_names__") + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_17_names__ -> (fun _ -> "loption_pf___anonymous_17_names__") + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf_USING_rnel_loc_using_by____ -> (fun _ -> "loption_pf_USING_rnel_loc_using_by____") + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf_UPON_names__ -> (fun _ -> "loption_pf_UPON_names__") + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf_ON_rnel_validation_stage___ -> (fun _ -> "loption_pf_ON_rnel_validation_stage___") + | MenhirInterpreter.N MenhirInterpreter.N_loption_indexed_by_ -> (fun _ -> "loption_indexed_by_") + | MenhirInterpreter.N MenhirInterpreter.N_loption_declaratives_ -> (fun _ -> "loption_declaratives_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_9_ -> (fun _ -> "loption___anonymous_9_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_8_ -> (fun _ -> "loption___anonymous_8_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_7_ -> (fun _ -> "loption___anonymous_7_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_6_ -> (fun _ -> "loption___anonymous_6_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_5_ -> (fun _ -> "loption___anonymous_5_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_49_ -> (fun _ -> "loption___anonymous_49_") + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_4_ -> (fun _ -> "loption___anonymous_4_") + | MenhirInterpreter.N MenhirInterpreter.N_lock_or_retry -> (fun _ -> "lock_or_retry") + | MenhirInterpreter.N MenhirInterpreter.N_lock_mode_clause -> (fun _ -> "lock_mode_clause") + | MenhirInterpreter.N MenhirInterpreter.N_lock_mode -> (fun _ -> "lock_mode") + | MenhirInterpreter.N MenhirInterpreter.N_locale_value_or_ident -> (fun _ -> "locale_value_or_ident") + | MenhirInterpreter.N MenhirInterpreter.N_locale_phrase -> (fun _ -> "locale_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_locale_or_default -> (fun _ -> "locale_or_default") + | MenhirInterpreter.N MenhirInterpreter.N_locale_or_ambiguous -> (fun _ -> "locale_or_ambiguous") + | MenhirInterpreter.N MenhirInterpreter.N_locale_clause -> (fun _ -> "locale_clause") + | MenhirInterpreter.N MenhirInterpreter.N_locale_category -> (fun _ -> "locale_category") + | MenhirInterpreter.N MenhirInterpreter.N_local_storage_section -> (fun _ -> "local_storage_section") + | MenhirInterpreter.N MenhirInterpreter.N_ll_rev_loc_compilation_unit__ -> (fun _ -> "ll_rev_loc_compilation_unit__") + | MenhirInterpreter.N MenhirInterpreter.N_ll_rev_and_clause_ -> (fun _ -> "ll_rev_and_clause_") + | MenhirInterpreter.N MenhirInterpreter.N_literal_through_literal -> (fun _ -> "literal_through_literal") + | MenhirInterpreter.N MenhirInterpreter.N_literal_phrase -> (fun _ -> "literal_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_literal_int_ident -> (fun _ -> "literal_int_ident") + | MenhirInterpreter.N MenhirInterpreter.N_literal -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_list_select_ -> (fun _ -> "list_select_") + | MenhirInterpreter.N MenhirInterpreter.N_list_pf_FILE_name__ -> (fun _ -> "list_pf_FILE_name__") + | MenhirInterpreter.N MenhirInterpreter.N_list_name_ -> (fun _ -> "list_name_") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_result_imperative_statement__ -> (fun _ -> "list_loc_result_imperative_statement__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_sort_merge_file_descr_clause__ -> (fun _ -> "list_loc_sort_merge_file_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_sentence__ -> (fun _ -> "list_loc_sentence__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_section_paragraph__ -> (fun _ -> "list_loc_section_paragraph__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_screen_descr_clause__ -> (fun _ -> "list_loc_screen_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_same_area_clause__ -> (fun _ -> "list_loc_same_area_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_rerun_clause__ -> (fun _ -> "list_loc_rerun_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_group_descr_clause__ -> (fun _ -> "list_loc_report_group_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_descr_entry__ -> (fun _ -> "list_loc_report_descr_entry__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_descr_clause__ -> (fun _ -> "list_loc_report_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_program_definition__ -> (fun _ -> "list_loc_program_definition__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_object_computer_clause__ -> (fun _ -> "list_loc_object_computer_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_multiple_file_clause__ -> (fun _ -> "list_loc_multiple_file_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_method_definition__ -> (fun _ -> "list_loc_method_definition__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_file_or_sort_merge_descr_entry__ -> (fun _ -> "list_loc_file_or_sort_merge_descr_entry__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_file_descr_clause__ -> (fun _ -> "list_loc_file_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_entry_name_clause__ -> (fun _ -> "list_loc_entry_name_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_data_descr_clause__ -> (fun _ -> "list_loc_data_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_screen_descr_entry__ -> (fun _ -> "list_loc_constant_or_screen_descr_entry__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_report_group_descr_entry__ -> (fun _ -> "list_loc_constant_or_report_group_descr_entry__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_data_descr_entry__ -> (fun _ -> "list_loc_constant_or_data_descr_entry__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_communication_descr_entry__ -> (fun _ -> "list_loc_communication_descr_entry__") + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_communication_descr_clause__ -> (fun _ -> "list_loc_communication_descr_clause__") + | MenhirInterpreter.N MenhirInterpreter.N_list_key_is_ -> (fun _ -> "list_key_is_") + | MenhirInterpreter.N MenhirInterpreter.N_list_inspect_where_ -> (fun _ -> "list_inspect_where_") + | MenhirInterpreter.N MenhirInterpreter.N_linkage_section -> (fun _ -> "linkage_section") + | MenhirInterpreter.N MenhirInterpreter.N_line_position -> (fun _ -> "line_position") + | MenhirInterpreter.N MenhirInterpreter.N_line_number -> (fun _ -> "line_number") + | MenhirInterpreter.N MenhirInterpreter.N_line_header -> (fun _ -> "line_header") + | MenhirInterpreter.N MenhirInterpreter.N_linage_header -> (fun _ -> "linage_header") + | MenhirInterpreter.N MenhirInterpreter.N_linage_clause -> (fun _ -> "linage_clause") + | MenhirInterpreter.N MenhirInterpreter.N_lc_all_or_default -> (fun _ -> "lc_all_or_default") + | MenhirInterpreter.N MenhirInterpreter.N_label_clause -> (fun _ -> "label_clause") + | MenhirInterpreter.N MenhirInterpreter.N_l_pf_AFTER_loc_varying_phrase___ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_l_loc___anonymous_79__ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_l___anonymous_99_ -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_key_is -> (fun _ -> "key_is") + | MenhirInterpreter.N MenhirInterpreter.N_justified_clause -> (fun _ -> "justified_clause") + | MenhirInterpreter.N MenhirInterpreter.N_io_control_paragraph -> (fun _ -> "io_control_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_io_control_entry -> (fun _ -> "io_control_entry") + | MenhirInterpreter.N MenhirInterpreter.N_invoke_statement -> (fun _ -> "invoke_statement") + | MenhirInterpreter.N MenhirInterpreter.N_invalid_when_clause -> (fun _ -> "invalid_when_clause") + | MenhirInterpreter.N MenhirInterpreter.N_intrinsic_function_name -> (fun _ -> "intrinsic_function_name") + | MenhirInterpreter.N MenhirInterpreter.N_intermediate_rounding_clause -> (fun _ -> "intermediate_rounding_clause") + | MenhirInterpreter.N MenhirInterpreter.N_interface_specifier -> (fun _ -> "interface_specifier") + | MenhirInterpreter.N MenhirInterpreter.N_interface_id_paragraph -> (fun _ -> "interface_id_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_interface_definition -> (fun _ -> "interface_definition") + | MenhirInterpreter.N MenhirInterpreter.N_integers -> (fun _ -> "integers") + | MenhirInterpreter.N MenhirInterpreter.N_integer -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_instance_definition -> (fun _ -> "instance_definition") + | MenhirInterpreter.N MenhirInterpreter.N_inspect_where -> (fun _ -> "inspect_where") + | MenhirInterpreter.N MenhirInterpreter.N_inspect_statement -> (fun _ -> "inspect_statement") + | MenhirInterpreter.N MenhirInterpreter.N_inspect_spec -> (fun _ -> "inspect_spec") + | MenhirInterpreter.N MenhirInterpreter.N_input_output_section -> (fun _ -> "input_output_section") + | MenhirInterpreter.N MenhirInterpreter.N_input_or_using -> (fun _ -> "input_or_using") + | MenhirInterpreter.N MenhirInterpreter.N_inline_invocation -> (fun _ -> "inline_invocation") + | MenhirInterpreter.N MenhirInterpreter.N_initiate_statement -> (fun _ -> "initiate_statement") + | MenhirInterpreter.N MenhirInterpreter.N_initialize_statement -> (fun _ -> "initialize_statement") + | MenhirInterpreter.N MenhirInterpreter.N_init_data_category -> (fun _ -> "init_data_category") + | MenhirInterpreter.N MenhirInterpreter.N_informational_paragraphs -> (fun _ -> "informational_paragraphs") + | MenhirInterpreter.N MenhirInterpreter.N_indexed_by -> (fun _ -> "indexed_by") + | MenhirInterpreter.N MenhirInterpreter.N_in_of -> (fun _ -> "in_of") + | MenhirInterpreter.N MenhirInterpreter.N_imperative_statement -> (fun _ -> "imperative_statement") + | MenhirInterpreter.N MenhirInterpreter.N_imp_stmts -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_if_statement_explicit_term -> (fun _ -> "if_statement_explicit_term") + | MenhirInterpreter.N MenhirInterpreter.N_if_statement -> (fun _ -> "if_statement") + | MenhirInterpreter.N MenhirInterpreter.N_if_body -> (fun _ -> "if_body") + | MenhirInterpreter.N MenhirInterpreter.N_idents -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_identification_division -> (fun _ -> "identification_division") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_string_no_all -> (fun _ -> "ident_or_string_no_all") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_string -> (fun _ -> "ident_or_string") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_numeric -> (fun _ -> "ident_or_numeric") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_nonnumeric_no_all -> (fun _ -> "ident_or_nonnumeric_no_all") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_nonnumeric -> (fun _ -> "ident_or_nonnumeric") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_nested -> (fun _ -> "ident_or_nested") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_literal -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_integer -> (fun _ -> "ident_or_integer") + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_alphanum -> (fun _ -> "ident_or_alphanum") + | MenhirInterpreter.N MenhirInterpreter.N_ident_by_after_before -> (fun _ -> "ident_by_after_before") + | MenhirInterpreter.N MenhirInterpreter.N_ident_after_before_list -> (fun _ -> "ident_after_before_list") + | MenhirInterpreter.N MenhirInterpreter.N_ident_after_before -> (fun _ -> "ident_after_before") + | MenhirInterpreter.N MenhirInterpreter.N_ident -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_group_usage_clause -> (fun _ -> "group_usage_clause") + | MenhirInterpreter.N MenhirInterpreter.N_group_indicate_clause -> (fun _ -> "group_indicate_clause") + | MenhirInterpreter.N MenhirInterpreter.N_goback_statement -> (fun _ -> "goback_statement") + | MenhirInterpreter.N MenhirInterpreter.N_go_to_statement -> (fun _ -> "go_to_statement") + | MenhirInterpreter.N MenhirInterpreter.N_global_clause -> (fun _ -> "global_clause") + | MenhirInterpreter.N MenhirInterpreter.N_generate_statement -> (fun _ -> "generate_statement") + | MenhirInterpreter.N MenhirInterpreter.N_function_unit -> (fun _ -> "function_unit") + | MenhirInterpreter.N MenhirInterpreter.N_function_specifier -> (fun _ -> "function_specifier") + | MenhirInterpreter.N MenhirInterpreter.N_function_name -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_function_ident -> (fun _ -> "function_ident") + | MenhirInterpreter.N MenhirInterpreter.N_function_id_paragraph -> (fun _ -> "function_id_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_from_to_characters_opt -> (fun _ -> "from_to_characters_opt") + | MenhirInterpreter.N MenhirInterpreter.N_free_statement -> (fun _ -> "free_statement") + | MenhirInterpreter.N MenhirInterpreter.N_format_clause -> (fun _ -> "format_clause") + | MenhirInterpreter.N MenhirInterpreter.N_for_alphanumeric_or_national_opt -> (fun _ -> "for_alphanumeric_or_national_opt") + | MenhirInterpreter.N MenhirInterpreter.N_floatlit -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_float_decimal_clause -> (fun _ -> "float_decimal_clause") + | MenhirInterpreter.N MenhirInterpreter.N_float_content -> (fun _ -> "float_content") + | MenhirInterpreter.N MenhirInterpreter.N_float_binary_clause -> (fun _ -> "float_binary_clause") + | MenhirInterpreter.N MenhirInterpreter.N_flat_combination_operand -> (fun _ -> "flat_combination_operand") + | MenhirInterpreter.N MenhirInterpreter.N_fixedlit -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_file_with_opt -> (fun _ -> "file_with_opt") + | MenhirInterpreter.N MenhirInterpreter.N_file_status_clause -> (fun _ -> "file_status_clause") + | MenhirInterpreter.N MenhirInterpreter.N_file_section -> (fun _ -> "file_section") + | MenhirInterpreter.N MenhirInterpreter.N_file_or_sort_merge_descr_entry -> (fun _ -> "file_or_sort_merge_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_file_descr_clause -> (fun _ -> "file_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_file_control_paragraph -> (fun _ -> "file_control_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_figurative_constant -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_factory_paragraph -> (fun _ -> "factory_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_factory_definition -> (fun _ -> "factory_definition") + | MenhirInterpreter.N MenhirInterpreter.N_external_clause -> (fun _ -> "external_clause") + | MenhirInterpreter.N MenhirInterpreter.N_extended_condition -> (fun _ -> "extended_condition") + | MenhirInterpreter.N MenhirInterpreter.N_expression_par_unop -> (fun _ -> "expression_par_unop") + | MenhirInterpreter.N MenhirInterpreter.N_expression_no_all -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_expression -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_expr_unary -> (fun _ -> "expr_unary") + | MenhirInterpreter.N MenhirInterpreter.N_expr_term_par_unop -> (fun _ -> "expr_term_par_unop") + | MenhirInterpreter.N MenhirInterpreter.N_expr_term_no_all -> (fun _ -> "expr_term_no_all") + | MenhirInterpreter.N MenhirInterpreter.N_expr_term -> (fun _ -> "expr_term") + | MenhirInterpreter.N MenhirInterpreter.N_expr_factor_par_unop -> (fun _ -> "expr_factor_par_unop") + | MenhirInterpreter.N MenhirInterpreter.N_expr_factor_no_all -> (fun _ -> "expr_factor_no_all") + | MenhirInterpreter.N MenhirInterpreter.N_expr_factor -> (fun _ -> "expr_factor") + | MenhirInterpreter.N MenhirInterpreter.N_expands_phrase -> (fun _ -> "expands_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_exit_statement -> (fun _ -> "exit_statement") + | MenhirInterpreter.N MenhirInterpreter.N_exit_spec -> (fun _ -> "exit_spec") + | MenhirInterpreter.N MenhirInterpreter.N_evaluate_statement -> (fun _ -> "evaluate_statement") + | MenhirInterpreter.N MenhirInterpreter.N_error_or_no_error -> (fun _ -> "error_or_no_error") + | MenhirInterpreter.N MenhirInterpreter.N_erase_clause -> (fun _ -> "erase_clause") + | MenhirInterpreter.N MenhirInterpreter.N_environment_division -> (fun _ -> "environment_division") + | MenhirInterpreter.N MenhirInterpreter.N_entry_name_clause -> (fun _ -> "entry_name_clause") + | MenhirInterpreter.N MenhirInterpreter.N_entry_convention_clause -> (fun _ -> "entry_convention_clause") + | MenhirInterpreter.N MenhirInterpreter.N_enter_statement -> (fun _ -> "enter_statement") + | MenhirInterpreter.N MenhirInterpreter.N_ending_indicator -> (fun _ -> "ending_indicator") + | MenhirInterpreter.N MenhirInterpreter.N_endianness_mode_ -> (fun _ -> "endianness_mode_") + | MenhirInterpreter.N MenhirInterpreter.N_endianness_mode -> (fun _ -> "endianness_mode") + | MenhirInterpreter.N MenhirInterpreter.N_end_subtract -> (fun _ -> "end_subtract") + | MenhirInterpreter.N MenhirInterpreter.N_end_search -> (fun _ -> "end_search") + | MenhirInterpreter.N MenhirInterpreter.N_end_multiply -> (fun _ -> "end_multiply") + | MenhirInterpreter.N MenhirInterpreter.N_end_divide -> (fun _ -> "end_divide") + | MenhirInterpreter.N MenhirInterpreter.N_end_display -> (fun _ -> "end_display") + | MenhirInterpreter.N MenhirInterpreter.N_end_add -> (fun _ -> "end_add") + | MenhirInterpreter.N MenhirInterpreter.N_end_accept -> (fun _ -> "end_accept") + | MenhirInterpreter.N MenhirInterpreter.N_encoding_mode -> (fun _ -> "encoding_mode") + | MenhirInterpreter.N MenhirInterpreter.N_encoding_endianness_opt -> (fun _ -> "encoding_endianness_opt") + | MenhirInterpreter.N MenhirInterpreter.N_encoding_endianness -> (fun _ -> "encoding_endianness") + | MenhirInterpreter.N MenhirInterpreter.N_enable_statement -> (fun _ -> "enable_statement") + | MenhirInterpreter.N MenhirInterpreter.N_else_phrase -> (fun _ -> "else_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_elementary_string_or_int_literal -> (fun _ -> "elementary_string_or_int_literal") + | MenhirInterpreter.N MenhirInterpreter.N_elementary_nonnumeric_literal -> (fun _ -> "elementary_nonnumeric_literal") + | MenhirInterpreter.N MenhirInterpreter.N_dynamic_length_structure_clause -> (fun _ -> "dynamic_length_structure_clause") + | MenhirInterpreter.N MenhirInterpreter.N_dynamic_length_clause -> (fun _ -> "dynamic_length_clause") + | MenhirInterpreter.N MenhirInterpreter.N_divide_statement -> (fun _ -> "divide_statement") + | MenhirInterpreter.N MenhirInterpreter.N_display_statement -> (fun _ -> "display_statement") + | MenhirInterpreter.N MenhirInterpreter.N_disable_statement -> (fun _ -> "disable_statement") + | MenhirInterpreter.N MenhirInterpreter.N_destination_clause -> (fun _ -> "destination_clause") + | MenhirInterpreter.N MenhirInterpreter.N_depending_phrase -> (fun _ -> "depending_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_delete_statement -> (fun _ -> "delete_statement") + | MenhirInterpreter.N MenhirInterpreter.N_default_section_clauses -> (fun _ -> "default_section_clauses") + | MenhirInterpreter.N MenhirInterpreter.N_default_section -> (fun _ -> "default_section") + | MenhirInterpreter.N MenhirInterpreter.N_default_display_clause -> (fun _ -> "default_display_clause") + | MenhirInterpreter.N MenhirInterpreter.N_default_clause -> (fun _ -> "default_clause") + | MenhirInterpreter.N MenhirInterpreter.N_default_accept_clause -> (fun _ -> "default_accept_clause") + | MenhirInterpreter.N MenhirInterpreter.N_declaratives -> (fun _ -> "declaratives") + | MenhirInterpreter.N MenhirInterpreter.N_decl_section_paragraph -> (fun _ -> "decl_section_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_decimal_point_clause -> (fun _ -> "decimal_point_clause") + | MenhirInterpreter.N MenhirInterpreter.N_debug_target -> (fun _ -> "debug_target") + | MenhirInterpreter.N MenhirInterpreter.N_date_day_time -> (fun _ -> "date_day_time") + | MenhirInterpreter.N MenhirInterpreter.N_data_value_clause -> (fun _ -> "data_value_clause") + | MenhirInterpreter.N MenhirInterpreter.N_data_type_clause -> (fun _ -> "data_type_clause") + | MenhirInterpreter.N MenhirInterpreter.N_data_occurs_clause -> (fun _ -> "data_occurs_clause") + | MenhirInterpreter.N MenhirInterpreter.N_data_division -> (fun _ -> "data_division") + | MenhirInterpreter.N MenhirInterpreter.N_data_descr_entry -> (fun _ -> "data_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_data_descr_clause -> (fun _ -> "data_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_data_clause -> (fun _ -> "data_clause") + | MenhirInterpreter.N MenhirInterpreter.N_cursor_clause -> (fun _ -> "cursor_clause") + | MenhirInterpreter.N MenhirInterpreter.N_currency_sign_clause -> (fun _ -> "currency_sign_clause") + | MenhirInterpreter.N MenhirInterpreter.N_cs_national -> (fun _ -> "cs_national") + | MenhirInterpreter.N MenhirInterpreter.N_cs_alphanumeric -> (fun _ -> "cs_alphanumeric") + | MenhirInterpreter.N MenhirInterpreter.N_crt_status_clause -> (fun _ -> "crt_status_clause") + | MenhirInterpreter.N MenhirInterpreter.N_counter -> (fun _ -> "counter") + | MenhirInterpreter.N MenhirInterpreter.N_control_division -> (fun _ -> "control_division") + | MenhirInterpreter.N MenhirInterpreter.N_control_clause -> (fun _ -> "control_clause") + | MenhirInterpreter.N MenhirInterpreter.N_continue_statement -> (fun _ -> "continue_statement") + | MenhirInterpreter.N MenhirInterpreter.N_constant_value_length -> (fun _ -> "constant_value_length") + | MenhirInterpreter.N MenhirInterpreter.N_constant_value -> (fun _ -> "constant_value") + | MenhirInterpreter.N MenhirInterpreter.N_constant_record_clause -> (fun _ -> "constant_record_clause") + | MenhirInterpreter.N MenhirInterpreter.N_constant_or_screen_descr_entry -> (fun _ -> "constant_or_screen_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_constant_or_report_group_descr_entry -> (fun _ -> "constant_or_report_group_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_constant_or_data_descr_entry -> (fun _ -> "constant_or_data_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_constant_level -> (fun _ -> "constant_level") + | MenhirInterpreter.N MenhirInterpreter.N_constant -> (fun _ -> "constant") + | MenhirInterpreter.N MenhirInterpreter.N_configuration_section -> (fun _ -> "configuration_section") + | MenhirInterpreter.N MenhirInterpreter.N_condition -> (fun _ -> "condition") + | MenhirInterpreter.N MenhirInterpreter.N_compute_statement -> (fun _ -> "compute_statement") + | MenhirInterpreter.N MenhirInterpreter.N_complex_condition -> (fun _ -> "complex_condition") + | MenhirInterpreter.N MenhirInterpreter.N_compilation_unit -> (fun _ -> "compilation_unit") + | MenhirInterpreter.N MenhirInterpreter.N_compilation_group -> (fun _ -> "compilation_group") + | MenhirInterpreter.N MenhirInterpreter.N_communication_section -> (fun _ -> "communication_section") + | MenhirInterpreter.N MenhirInterpreter.N_communication_descr_entry -> (fun _ -> "communication_descr_entry") + | MenhirInterpreter.N MenhirInterpreter.N_communication_descr_clause -> (fun _ -> "communication_descr_clause") + | MenhirInterpreter.N MenhirInterpreter.N_column_position -> (fun _ -> "column_position") + | MenhirInterpreter.N MenhirInterpreter.N_column_number -> (fun _ -> "column_number") + | MenhirInterpreter.N MenhirInterpreter.N_column_header -> (fun _ -> "column_header") + | MenhirInterpreter.N MenhirInterpreter.N_collating_sequence_phrase -> (fun _ -> "collating_sequence_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_collating_sequence_clause -> (fun _ -> "collating_sequence_clause") + | MenhirInterpreter.N MenhirInterpreter.N_code_set_clause -> (fun _ -> "code_set_clause") + | MenhirInterpreter.N MenhirInterpreter.N_code_clause -> (fun _ -> "code_clause") + | MenhirInterpreter.N MenhirInterpreter.N_close_statement -> (fun _ -> "close_statement") + | MenhirInterpreter.N MenhirInterpreter.N_close_format -> (fun _ -> "close_format") + | MenhirInterpreter.N MenhirInterpreter.N_class_specifier -> (fun _ -> "class_specifier") + | MenhirInterpreter.N MenhirInterpreter.N_class_name_clause -> (fun _ -> "class_name_clause") + | MenhirInterpreter.N MenhirInterpreter.N_class_id_paragraph -> (fun _ -> "class_id_paragraph") + | MenhirInterpreter.N MenhirInterpreter.N_class_definition -> (fun _ -> "class_definition") + | MenhirInterpreter.N MenhirInterpreter.N_class_condition_no_ident -> (fun _ -> "class_condition_no_ident") + | MenhirInterpreter.N MenhirInterpreter.N_class_condition -> (fun _ -> "class_condition") + | MenhirInterpreter.N MenhirInterpreter.N_class_clause -> (fun _ -> "class_clause") + | MenhirInterpreter.N MenhirInterpreter.N_class_ -> (fun _ -> "class_") + | MenhirInterpreter.N MenhirInterpreter.N_character_set -> (fun _ -> "character_set") + | MenhirInterpreter.N MenhirInterpreter.N_character_classification_clause -> (fun _ -> "character_classification_clause") + | MenhirInterpreter.N MenhirInterpreter.N_character_classification -> (fun _ -> "character_classification") + | MenhirInterpreter.N MenhirInterpreter.N_cc_national -> (fun _ -> "cc_national") + | MenhirInterpreter.N MenhirInterpreter.N_cc_alphanumeric -> (fun _ -> "cc_alphanumeric") + | MenhirInterpreter.N MenhirInterpreter.N_category_to_value -> (fun _ -> "category_to_value") + | MenhirInterpreter.N MenhirInterpreter.N_capacity_phrase -> (fun _ -> "capacity_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_cancel_statement -> (fun _ -> "cancel_statement") + | MenhirInterpreter.N MenhirInterpreter.N_call_using_by -> (fun _ -> "call_using_by") + | MenhirInterpreter.N MenhirInterpreter.N_call_statement -> (fun _ -> "call_statement") + | MenhirInterpreter.N MenhirInterpreter.N_call_prefix -> (fun _ -> "call_prefix") + | MenhirInterpreter.N MenhirInterpreter.N_boption_or__RECORD_RECORDS__ -> (fun _ -> "boption_or__RECORD_RECORDS__") + | MenhirInterpreter.N MenhirInterpreter.N_boption_or__LINE_LINES__ -> (fun _ -> "boption_or__LINE_LINES__") + | MenhirInterpreter.N MenhirInterpreter.N_boption_identification_division_ -> (fun _ -> "boption_identification_division_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_87_ -> (fun _ -> "boption___anonymous_87_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_81_ -> (fun _ -> "boption___anonymous_81_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_71_ -> (fun _ -> "boption___anonymous_71_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_60_ -> (fun _ -> "boption___anonymous_60_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_56_ -> (fun _ -> "boption___anonymous_56_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_47_ -> (fun _ -> "boption___anonymous_47_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_46_ -> (fun _ -> "boption___anonymous_46_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_45_ -> (fun _ -> "boption___anonymous_45_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_41_ -> (fun _ -> "boption___anonymous_41_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_3_ -> (fun _ -> "boption___anonymous_3_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_18_ -> (fun _ -> "boption___anonymous_18_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_12_ -> (fun _ -> "boption___anonymous_12_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_11_ -> (fun _ -> "boption___anonymous_11_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_102_ -> (fun _ -> "boption___anonymous_102_") + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_10_ -> (fun _ -> "boption___anonymous_10_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_YYYYMMDD_ -> (fun _ -> "boption_YYYYMMDD_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_YYYYDDD_ -> (fun _ -> "boption_YYYYDDD_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_STRONG_ -> (fun _ -> "boption_STRONG_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_SIGNED_ -> (fun _ -> "boption_SIGNED_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_SHORT_ -> (fun _ -> "boption_SHORT_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_OVERRIDE_ -> (fun _ -> "boption_OVERRIDE_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_OPTIONAL_ -> (fun _ -> "boption_OPTIONAL_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_ONLY_ -> (fun _ -> "boption_ONLY_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_NOT_ -> (fun _ -> "boption_NOT_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_MULTIPLE_ -> (fun _ -> "boption_MULTIPLE_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_IN_ARITHMETIC_RANGE_ -> (fun _ -> "boption_IN_ARITHMETIC_RANGE_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_INITIALIZED_ -> (fun _ -> "boption_INITIALIZED_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_INITIAL_ -> (fun _ -> "boption_INITIAL_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_GLOBAL_ -> (fun _ -> "boption_GLOBAL_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_CYCLE_ -> (fun _ -> "boption_CYCLE_") + | MenhirInterpreter.N MenhirInterpreter.N_boption_ALL_ -> (fun _ -> "boption_ALL_") + | MenhirInterpreter.N MenhirInterpreter.N_boollit -> (fun _ -> "boollit") + | MenhirInterpreter.N MenhirInterpreter.N_block_contains_clause -> (fun _ -> "block_contains_clause") + | MenhirInterpreter.N MenhirInterpreter.N_blank_when_zero_clause -> (fun _ -> "blank_when_zero_clause") + | MenhirInterpreter.N MenhirInterpreter.N_blank_clause -> (fun _ -> "blank_clause") + | MenhirInterpreter.N MenhirInterpreter.N_based_clause -> (fun _ -> "based_clause") + | MenhirInterpreter.N MenhirInterpreter.N_atomic_expression_no_all -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_atomic_expression -> (fun _ -> "") + | MenhirInterpreter.N MenhirInterpreter.N_at_eop -> (fun _ -> "at_eop") + | MenhirInterpreter.N MenhirInterpreter.N_at_end -> (fun _ -> "at_end") + | MenhirInterpreter.N MenhirInterpreter.N_assign_clause -> (fun _ -> "assign_clause") + | MenhirInterpreter.N MenhirInterpreter.N_as__strlit_ -> (fun _ -> "as__strlit_") + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_term_no_all -> (fun _ -> "arithmetic_term_no_all") + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_term -> (fun _ -> "arithmetic_term") + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_mode -> (fun _ -> "arithmetic_mode") + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_clause -> (fun _ -> "arithmetic_clause") + | MenhirInterpreter.N MenhirInterpreter.N_argument -> (fun _ -> "argument") + | MenhirInterpreter.N MenhirInterpreter.N_area_source -> (fun _ -> "area_source") + | MenhirInterpreter.N MenhirInterpreter.N_any_length_clause -> (fun _ -> "any_length_clause") + | MenhirInterpreter.N MenhirInterpreter.N_and_clause -> (fun _ -> "and_clause") + | MenhirInterpreter.N MenhirInterpreter.N_alternate_record_key_clause -> (fun _ -> "alternate_record_key_clause") + | MenhirInterpreter.N MenhirInterpreter.N_alter_statement -> (fun _ -> "alter_statement") + | MenhirInterpreter.N MenhirInterpreter.N_alphabet_specification -> (fun _ -> "alphabet_specification") + | MenhirInterpreter.N MenhirInterpreter.N_alphabet_name_clause -> (fun _ -> "alphabet_name_clause") + | MenhirInterpreter.N MenhirInterpreter.N_allocate_statement -> (fun _ -> "allocate_statement") + | MenhirInterpreter.N MenhirInterpreter.N_alignment -> (fun _ -> "alignment") + | MenhirInterpreter.N MenhirInterpreter.N_aligned_clause -> (fun _ -> "aligned_clause") + | MenhirInterpreter.N MenhirInterpreter.N_after_or_before -> (fun _ -> "after_or_before") + | MenhirInterpreter.N MenhirInterpreter.N_advancing_phrase -> (fun _ -> "advancing_phrase") + | MenhirInterpreter.N MenhirInterpreter.N_address -> (fun _ -> "address") + | MenhirInterpreter.N MenhirInterpreter.N_add_statement -> (fun _ -> "add_statement") + | MenhirInterpreter.N MenhirInterpreter.N_access_mode_clause -> (fun _ -> "access_mode_clause") + | MenhirInterpreter.N MenhirInterpreter.N_access_mode -> (fun _ -> "access_mode") + | MenhirInterpreter.N MenhirInterpreter.N_accept_statement -> (fun _ -> "accept_statement") + | MenhirInterpreter.N MenhirInterpreter.N__assign_external_ -> (fun _ -> "_assign_external_") + +let print_token = function + | ZERO_FILL -> print_value (MenhirInterpreter.T T_ZERO_FILL) () + | ZERO -> print_value (MenhirInterpreter.T T_ZERO) () + | YYYYMMDD -> print_value (MenhirInterpreter.T T_YYYYMMDD) () + | YYYYDDD -> print_value (MenhirInterpreter.T T_YYYYDDD) () + | Y -> print_value (MenhirInterpreter.T T_Y) () + | XOR -> print_value (MenhirInterpreter.T T_XOR) () + | XML_SCHEMA -> print_value (MenhirInterpreter.T T_XML_SCHEMA) () + | XML_DECLARATION -> print_value (MenhirInterpreter.T T_XML_DECLARATION) () + | XML -> print_value (MenhirInterpreter.T T_XML) () + | X -> print_value (MenhirInterpreter.T T_X) () + | WRITE_VERIFY -> print_value (MenhirInterpreter.T T_WRITE_VERIFY) () + | WRITE_ONLY -> print_value (MenhirInterpreter.T T_WRITE_ONLY) () + | WRITERS -> print_value (MenhirInterpreter.T T_WRITERS) () + | WRITE -> print_value (MenhirInterpreter.T T_WRITE) () + | WRAP -> print_value (MenhirInterpreter.T T_WRAP) () + | WORKING_STORAGE -> print_value (MenhirInterpreter.T T_WORKING_STORAGE) () + | WORD_IN_AREA_A v -> print_value (MenhirInterpreter.T T_WORD_IN_AREA_A) v + | WORDS -> print_value (MenhirInterpreter.T T_WORDS) () + | WORD v -> print_value (MenhirInterpreter.T T_WORD) v + | WITH_DATA -> print_value (MenhirInterpreter.T T_WITH_DATA) () + | WITH -> print_value (MenhirInterpreter.T T_WITH) () + | WINDOW -> print_value (MenhirInterpreter.T T_WINDOW) () + | WIDTH_IN_CELLS -> print_value (MenhirInterpreter.T T_WIDTH_IN_CELLS) () + | WIDTH -> print_value (MenhirInterpreter.T T_WIDTH) () + | WHEN -> print_value (MenhirInterpreter.T T_WHEN) () + | WEB_BROWSER -> print_value (MenhirInterpreter.T T_WEB_BROWSER) () + | WAIT -> print_value (MenhirInterpreter.T T_WAIT) () + | VTOP -> print_value (MenhirInterpreter.T T_VTOP) () + | VSCROLL_POS -> print_value (MenhirInterpreter.T T_VSCROLL_POS) () + | VSCROLL_BAR -> print_value (MenhirInterpreter.T T_VSCROLL_BAR) () + | VSCROLL -> print_value (MenhirInterpreter.T T_VSCROLL) () + | VPADDING -> print_value (MenhirInterpreter.T T_VPADDING) () + | VOLATILE -> print_value (MenhirInterpreter.T T_VOLATILE) () + | VLR -> print_value (MenhirInterpreter.T T_VLR) () + | VIRTUAL_WIDTH -> print_value (MenhirInterpreter.T T_VIRTUAL_WIDTH) () + | VIRTUAL -> print_value (MenhirInterpreter.T T_VIRTUAL) () + | VIA -> print_value (MenhirInterpreter.T T_VIA) () + | VERY_HEAVY -> print_value (MenhirInterpreter.T T_VERY_HEAVY) () + | VERTICAL -> print_value (MenhirInterpreter.T T_VERTICAL) () + | VARYING -> print_value (MenhirInterpreter.T T_VARYING) () + | VARIANT -> print_value (MenhirInterpreter.T T_VARIANT) () + | VARIABLE -> print_value (MenhirInterpreter.T T_VARIABLE) () + | VALUE_FORMAT -> print_value (MenhirInterpreter.T T_VALUE_FORMAT) () + | VALUES -> print_value (MenhirInterpreter.T T_VALUES) () + | VALUE -> print_value (MenhirInterpreter.T T_VALUE) () + | VALIDATING -> print_value (MenhirInterpreter.T T_VALIDATING) () + | VALIDATE_STATUS -> print_value (MenhirInterpreter.T T_VALIDATE_STATUS) () + | VALIDATE -> print_value (MenhirInterpreter.T T_VALIDATE) () + | VALID -> print_value (MenhirInterpreter.T T_VALID) () + | V -> print_value (MenhirInterpreter.T T_V) () + | UTF_8 -> print_value (MenhirInterpreter.T T_UTF_8) () + | UTF_16 -> print_value (MenhirInterpreter.T T_UTF_16) () + | USING -> print_value (MenhirInterpreter.T T_USING) () + | USE_TAB -> print_value (MenhirInterpreter.T T_USE_TAB) () + | USE_RETURN -> print_value (MenhirInterpreter.T T_USE_RETURN) () + | USE_ALT -> print_value (MenhirInterpreter.T T_USE_ALT) () + | USER_DEFAULT -> print_value (MenhirInterpreter.T T_USER_DEFAULT) () + | USER -> print_value (MenhirInterpreter.T T_USER) () + | USE -> print_value (MenhirInterpreter.T T_USE) () + | USAGE -> print_value (MenhirInterpreter.T T_USAGE) () + | UPPER -> print_value (MenhirInterpreter.T T_UPPER) () + | UPON -> print_value (MenhirInterpreter.T T_UPON) () + | UPDATERS -> print_value (MenhirInterpreter.T T_UPDATERS) () + | UPDATE -> print_value (MenhirInterpreter.T T_UPDATE) () + | UP -> print_value (MenhirInterpreter.T T_UP) () + | UNUSED__ -> print_value (MenhirInterpreter.T T_UNUSED__) () + | UNTIL -> print_value (MenhirInterpreter.T T_UNTIL) () + | UNSTRING -> print_value (MenhirInterpreter.T T_UNSTRING) () + | UNSORTED -> print_value (MenhirInterpreter.T T_UNSORTED) () + | UNSIGNED_SHORT -> print_value (MenhirInterpreter.T T_UNSIGNED_SHORT) () + | UNSIGNED_LONG -> print_value (MenhirInterpreter.T T_UNSIGNED_LONG) () + | UNSIGNED_INT -> print_value (MenhirInterpreter.T T_UNSIGNED_INT) () + | UNSIGNED -> print_value (MenhirInterpreter.T T_UNSIGNED) () + | UNSEQUAL -> print_value (MenhirInterpreter.T T_UNSEQUAL) () + | UNLOCK -> print_value (MenhirInterpreter.T T_UNLOCK) () + | UNIVERSAL -> print_value (MenhirInterpreter.T T_UNIVERSAL) () + | UNIT -> print_value (MenhirInterpreter.T T_UNIT) () + | UNFRAMED -> print_value (MenhirInterpreter.T T_UNFRAMED) () + | UNDERLINE -> print_value (MenhirInterpreter.T T_UNDERLINE) () + | UNBOUNDED -> print_value (MenhirInterpreter.T T_UNBOUNDED) () + | UFF -> print_value (MenhirInterpreter.T T_UFF) () + | UCS_4 -> print_value (MenhirInterpreter.T T_UCS_4) () + | U -> print_value (MenhirInterpreter.T T_U) () + | TYPEDEF -> print_value (MenhirInterpreter.T T_TYPEDEF) () + | TYPE -> print_value (MenhirInterpreter.T T_TYPE) () + | TRUNCATION -> print_value (MenhirInterpreter.T T_TRUNCATION) () + | TRUE -> print_value (MenhirInterpreter.T T_TRUE) () + | TREE_VIEW -> print_value (MenhirInterpreter.T T_TREE_VIEW) () + | TRANSPARENT -> print_value (MenhirInterpreter.T T_TRANSPARENT) () + | TRANSFORM -> print_value (MenhirInterpreter.T T_TRANSFORM) () + | TRAILING_SIGN -> print_value (MenhirInterpreter.T T_TRAILING_SIGN) () + | TRAILING_SHIFT -> print_value (MenhirInterpreter.T T_TRAILING_SHIFT) () + | TRAILING -> print_value (MenhirInterpreter.T T_TRAILING) () + | TRADITIONAL_FONT -> print_value (MenhirInterpreter.T T_TRADITIONAL_FONT) () + | TRACK_LIMIT -> print_value (MenhirInterpreter.T T_TRACK_LIMIT) () + | TRACK_AREA -> print_value (MenhirInterpreter.T T_TRACK_AREA) () + | TRACKS -> print_value (MenhirInterpreter.T T_TRACKS) () + | TRACK -> print_value (MenhirInterpreter.T T_TRACK) () + | TOWARD_LESSER -> print_value (MenhirInterpreter.T T_TOWARD_LESSER) () + | TOWARD_GREATER -> print_value (MenhirInterpreter.T T_TOWARD_GREATER) () + | TOP_LEVEL -> print_value (MenhirInterpreter.T T_TOP_LEVEL) () + | TOP -> print_value (MenhirInterpreter.T T_TOP) () + | TO -> print_value (MenhirInterpreter.T T_TO) () + | TITLE_POSITION -> print_value (MenhirInterpreter.T T_TITLE_POSITION) () + | TITLE -> print_value (MenhirInterpreter.T T_TITLE) () + | TIME_OUT -> print_value (MenhirInterpreter.T T_TIME_OUT) () + | TIMES -> print_value (MenhirInterpreter.T T_TIMES) () + | TIME -> print_value (MenhirInterpreter.T T_TIME) () + | TILED_HEADINGS -> print_value (MenhirInterpreter.T T_TILED_HEADINGS) () + | THUMB_POSITION -> print_value (MenhirInterpreter.T T_THUMB_POSITION) () + | THROUGH -> print_value (MenhirInterpreter.T T_THROUGH) () + | THREEDIMENSIONAL -> print_value (MenhirInterpreter.T T_THREEDIMENSIONAL) () + | THREADS -> print_value (MenhirInterpreter.T T_THREADS) () + | THREAD -> print_value (MenhirInterpreter.T T_THREAD) () + | THEN -> print_value (MenhirInterpreter.T T_THEN) () + | THAN -> print_value (MenhirInterpreter.T T_THAN) () + | TEXT -> print_value (MenhirInterpreter.T T_TEXT) () + | TEST -> print_value (MenhirInterpreter.T T_TEST) () + | TERMINATION_VALUE -> print_value (MenhirInterpreter.T T_TERMINATION_VALUE) () + | TERMINATE -> print_value (MenhirInterpreter.T T_TERMINATE) () + | TERMINAL_X -> print_value (MenhirInterpreter.T T_TERMINAL_X) () + | TERMINAL_INFO -> print_value (MenhirInterpreter.T T_TERMINAL_INFO) () + | TERMINAL_3 -> print_value (MenhirInterpreter.T T_TERMINAL_3) () + | TERMINAL_2 -> print_value (MenhirInterpreter.T T_TERMINAL_2) () + | TERMINAL_1 -> print_value (MenhirInterpreter.T T_TERMINAL_1) () + | TERMINAL_0 -> print_value (MenhirInterpreter.T T_TERMINAL_0) () + | TERMINAL -> print_value (MenhirInterpreter.T T_TERMINAL) () + | TEMPORARY -> print_value (MenhirInterpreter.T T_TEMPORARY) () + | TEMP -> print_value (MenhirInterpreter.T T_TEMP) () + | TAPE -> print_value (MenhirInterpreter.T T_TAPE) () + | TALLYING -> print_value (MenhirInterpreter.T T_TALLYING) () + | TAB_TO_DELETE -> print_value (MenhirInterpreter.T T_TAB_TO_DELETE) () + | TAB_TO_ADD -> print_value (MenhirInterpreter.T T_TAB_TO_ADD) () + | TABLE -> print_value (MenhirInterpreter.T T_TABLE) () + | TAB -> print_value (MenhirInterpreter.T T_TAB) () + | SYSTEM_OFFSET -> print_value (MenhirInterpreter.T T_SYSTEM_OFFSET) () + | SYSTEM_INFO -> print_value (MenhirInterpreter.T T_SYSTEM_INFO) () + | SYSTEM_DEFAULT -> print_value (MenhirInterpreter.T T_SYSTEM_DEFAULT) () + | SYSTEM -> print_value (MenhirInterpreter.T T_SYSTEM) () + | SYSOUT_X -> print_value (MenhirInterpreter.T T_SYSOUT_X) () + | SYSOUT_3 -> print_value (MenhirInterpreter.T T_SYSOUT_3) () + | SYSOUT_2 -> print_value (MenhirInterpreter.T T_SYSOUT_2) () + | SYSOUT_1 -> print_value (MenhirInterpreter.T T_SYSOUT_1) () + | SYSOUT_0 -> print_value (MenhirInterpreter.T T_SYSOUT_0) () + | SYSIN_X -> print_value (MenhirInterpreter.T T_SYSIN_X) () + | SYSIN_3 -> print_value (MenhirInterpreter.T T_SYSIN_3) () + | SYSIN_2 -> print_value (MenhirInterpreter.T T_SYSIN_2) () + | SYSIN_1 -> print_value (MenhirInterpreter.T T_SYSIN_1) () + | SYSIN_0 -> print_value (MenhirInterpreter.T T_SYSIN_0) () + | SYNCHRONIZED -> print_value (MenhirInterpreter.T T_SYNCHRONIZED) () + | SYMBOLIC -> print_value (MenhirInterpreter.T T_SYMBOLIC) () + | SYMBOL -> print_value (MenhirInterpreter.T T_SYMBOL) () + | SWITCH -> print_value (MenhirInterpreter.T T_SWITCH) () + | SUPPRESS -> print_value (MenhirInterpreter.T T_SUPPRESS) () + | SUPER -> print_value (MenhirInterpreter.T T_SUPER) () + | SUM -> print_value (MenhirInterpreter.T T_SUM) () + | SUB_SCHEMA -> print_value (MenhirInterpreter.T T_SUB_SCHEMA) () + | SUB_QUEUE_3 -> print_value (MenhirInterpreter.T T_SUB_QUEUE_3) () + | SUB_QUEUE_2 -> print_value (MenhirInterpreter.T T_SUB_QUEUE_2) () + | SUB_QUEUE_1 -> print_value (MenhirInterpreter.T T_SUB_QUEUE_1) () + | SUBWINDOW -> print_value (MenhirInterpreter.T T_SUBWINDOW) () + | SUBTRACT -> print_value (MenhirInterpreter.T T_SUBTRACT) () + | STYLE -> print_value (MenhirInterpreter.T T_STYLE) () + | STRUCTURE -> print_value (MenhirInterpreter.T T_STRUCTURE) () + | STRONG -> print_value (MenhirInterpreter.T T_STRONG) () + | STRING -> print_value (MenhirInterpreter.T T_STRING) () + | STOP -> print_value (MenhirInterpreter.T T_STOP) () + | STEP -> print_value (MenhirInterpreter.T T_STEP) () + | STDCALL -> print_value (MenhirInterpreter.T T_STDCALL) () + | STATUS_TEXT -> print_value (MenhirInterpreter.T T_STATUS_TEXT) () + | STATUS_BAR -> print_value (MenhirInterpreter.T T_STATUS_BAR) () + | STATUS -> print_value (MenhirInterpreter.T T_STATUS) () + | STATION -> print_value (MenhirInterpreter.T T_STATION) () + | STATIC_LIST -> print_value (MenhirInterpreter.T T_STATIC_LIST) () + | STATIC -> print_value (MenhirInterpreter.T T_STATIC) () + | STATEMENT -> print_value (MenhirInterpreter.T T_STATEMENT) () + | START_Y -> print_value (MenhirInterpreter.T T_START_Y) () + | START_X -> print_value (MenhirInterpreter.T T_START_X) () + | START -> print_value (MenhirInterpreter.T T_START) () + | STANDARD_DECIMAL -> print_value (MenhirInterpreter.T T_STANDARD_DECIMAL) () + | STANDARD_BINARY -> print_value (MenhirInterpreter.T T_STANDARD_BINARY) () + | STANDARD_2 -> print_value (MenhirInterpreter.T T_STANDARD_2) () + | STANDARD_1 -> print_value (MenhirInterpreter.T T_STANDARD_1) () + | STANDARD -> print_value (MenhirInterpreter.T T_STANDARD) () + | STACK -> print_value (MenhirInterpreter.T T_STACK) () + | SSF -> print_value (MenhirInterpreter.T T_SSF) () + | SQUARE -> print_value (MenhirInterpreter.T T_SQUARE) () + | SPINNER -> print_value (MenhirInterpreter.T T_SPINNER) () + | SPECIAL_NAMES -> print_value (MenhirInterpreter.T T_SPECIAL_NAMES) () + | SPACE_FILL -> print_value (MenhirInterpreter.T T_SPACE_FILL) () + | SPACE -> print_value (MenhirInterpreter.T T_SPACE) () + | SOURCE_COMPUTER -> print_value (MenhirInterpreter.T T_SOURCE_COMPUTER) () + | SOURCES -> print_value (MenhirInterpreter.T T_SOURCES) () + | SOURCE -> print_value (MenhirInterpreter.T T_SOURCE) () + | SORT_ORDER -> print_value (MenhirInterpreter.T T_SORT_ORDER) () + | SORT_MERGE -> print_value (MenhirInterpreter.T T_SORT_MERGE) () + | SORT -> print_value (MenhirInterpreter.T T_SORT) () + | SMALL_FONT -> print_value (MenhirInterpreter.T T_SMALL_FONT) () + | SLASH -> print_value (MenhirInterpreter.T T_SLASH) () + | SIZE -> print_value (MenhirInterpreter.T T_SIZE) () + | SINTLIT v -> print_value (MenhirInterpreter.T T_SINTLIT) v + | SIGNED_SHORT -> print_value (MenhirInterpreter.T T_SIGNED_SHORT) () + | SIGNED_LONG -> print_value (MenhirInterpreter.T T_SIGNED_LONG) () + | SIGNED_INT -> print_value (MenhirInterpreter.T T_SIGNED_INT) () + | SIGNED -> print_value (MenhirInterpreter.T T_SIGNED) () + | SIGN -> print_value (MenhirInterpreter.T T_SIGN) () + | SHOW_SEL_ALWAYS -> print_value (MenhirInterpreter.T T_SHOW_SEL_ALWAYS) () + | SHOW_NONE -> print_value (MenhirInterpreter.T T_SHOW_NONE) () + | SHOW_LINES -> print_value (MenhirInterpreter.T T_SHOW_LINES) () + | SHORT_DATE -> print_value (MenhirInterpreter.T T_SHORT_DATE) () + | SHORT -> print_value (MenhirInterpreter.T T_SHORT) () + | SHARING -> print_value (MenhirInterpreter.T T_SHARING) () + | SHADOW -> print_value (MenhirInterpreter.T T_SHADOW) () + | SHADING -> print_value (MenhirInterpreter.T T_SHADING) () + | SET -> print_value (MenhirInterpreter.T T_SET) () + | SEQUENTIAL -> print_value (MenhirInterpreter.T T_SEQUENTIAL) () + | SEQUENCE -> print_value (MenhirInterpreter.T T_SEQUENCE) () + | SEPARATION -> print_value (MenhirInterpreter.T T_SEPARATION) () + | SEPARATE -> print_value (MenhirInterpreter.T T_SEPARATE) () + | SENTENCE -> print_value (MenhirInterpreter.T T_SENTENCE) () + | SEND -> print_value (MenhirInterpreter.T T_SEND) () + | SELF_ACT -> print_value (MenhirInterpreter.T T_SELF_ACT) () + | SELF -> print_value (MenhirInterpreter.T T_SELF) () + | SELECT_ALL -> print_value (MenhirInterpreter.T T_SELECT_ALL) () + | SELECTION_TEXT -> print_value (MenhirInterpreter.T T_SELECTION_TEXT) () + | SELECTION_INDEX -> print_value (MenhirInterpreter.T T_SELECTION_INDEX) () + | SELECTION -> print_value (MenhirInterpreter.T T_SELECTION) () + | SELECT -> print_value (MenhirInterpreter.T T_SELECT) () + | SEGMENT_LIMIT -> print_value (MenhirInterpreter.T T_SEGMENT_LIMIT) () + | SEGMENT -> print_value (MenhirInterpreter.T T_SEGMENT) () + | SECURITY v -> print_value (MenhirInterpreter.T T_SECURITY) v + | SECURE -> print_value (MenhirInterpreter.T T_SECURE) () + | SECTION -> print_value (MenhirInterpreter.T T_SECTION) () + | SECONDS -> print_value (MenhirInterpreter.T T_SECONDS) () + | SECONDARY -> print_value (MenhirInterpreter.T T_SECONDARY) () + | SEARCH_TEXT -> print_value (MenhirInterpreter.T T_SEARCH_TEXT) () + | SEARCH_OPTIONS -> print_value (MenhirInterpreter.T T_SEARCH_OPTIONS) () + | SEARCH -> print_value (MenhirInterpreter.T T_SEARCH) () + | SD -> print_value (MenhirInterpreter.T T_SD) () + | SCROLL_BAR -> print_value (MenhirInterpreter.T T_SCROLL_BAR) () + | SCROLL -> print_value (MenhirInterpreter.T T_SCROLL) () + | SCREEN -> print_value (MenhirInterpreter.T T_SCREEN) () + | SAVE_AS_NO_PROMPT -> print_value (MenhirInterpreter.T T_SAVE_AS_NO_PROMPT) () + | SAVE_AS -> print_value (MenhirInterpreter.T T_SAVE_AS) () + | SARF -> print_value (MenhirInterpreter.T T_SARF) () + | SAME -> print_value (MenhirInterpreter.T T_SAME) () + | S -> print_value (MenhirInterpreter.T T_S) () + | RUN -> print_value (MenhirInterpreter.T T_RUN) () + | RPAR -> print_value (MenhirInterpreter.T T_RPAR) () + | ROW_PROTECTION -> print_value (MenhirInterpreter.T T_ROW_PROTECTION) () + | ROW_HEADINGS -> print_value (MenhirInterpreter.T T_ROW_HEADINGS) () + | ROW_FONT -> print_value (MenhirInterpreter.T T_ROW_FONT) () + | ROW_DIVIDERS -> print_value (MenhirInterpreter.T T_ROW_DIVIDERS) () + | ROW_COLOR_PATTERN -> print_value (MenhirInterpreter.T T_ROW_COLOR_PATTERN) () + | ROW_COLOR -> print_value (MenhirInterpreter.T T_ROW_COLOR) () + | ROUNDING -> print_value (MenhirInterpreter.T T_ROUNDING) () + | ROUNDED -> print_value (MenhirInterpreter.T T_ROUNDED) () + | ROLLBACK -> print_value (MenhirInterpreter.T T_ROLLBACK) () + | RIMMED -> print_value (MenhirInterpreter.T T_RIMMED) () + | RIGHT_JUSTIFY -> print_value (MenhirInterpreter.T T_RIGHT_JUSTIFY) () + | RIGHT_ALIGN -> print_value (MenhirInterpreter.T T_RIGHT_ALIGN) () + | RIGHT -> print_value (MenhirInterpreter.T T_RIGHT) () + | RH -> print_value (MenhirInterpreter.T T_RH) () + | RF -> print_value (MenhirInterpreter.T T_RF) () + | REWRITE -> print_value (MenhirInterpreter.T T_REWRITE) () + | REWIND -> print_value (MenhirInterpreter.T T_REWIND) () + | REVERSE_VIDEO -> print_value (MenhirInterpreter.T T_REVERSE_VIDEO) () + | REVERSED -> print_value (MenhirInterpreter.T T_REVERSED) () + | REVERSE -> print_value (MenhirInterpreter.T T_REVERSE) () + | RETURNING -> print_value (MenhirInterpreter.T T_RETURNING) () + | RETURN -> print_value (MenhirInterpreter.T T_RETURN) () + | RETRY -> print_value (MenhirInterpreter.T T_RETRY) () + | RETENTION -> print_value (MenhirInterpreter.T T_RETENTION) () + | RESUME -> print_value (MenhirInterpreter.T T_RESUME) () + | RESET_TABS -> print_value (MenhirInterpreter.T T_RESET_TABS) () + | RESET_LIST -> print_value (MenhirInterpreter.T T_RESET_LIST) () + | RESET_GRID -> print_value (MenhirInterpreter.T T_RESET_GRID) () + | RESET -> print_value (MenhirInterpreter.T T_RESET) () + | RESERVE -> print_value (MenhirInterpreter.T T_RESERVE) () + | RERUN -> print_value (MenhirInterpreter.T T_RERUN) () + | REREAD -> print_value (MenhirInterpreter.T T_REREAD) () + | REQUIRED -> print_value (MenhirInterpreter.T T_REQUIRED) () + | REPOSITORY -> print_value (MenhirInterpreter.T T_REPOSITORY) () + | REPORTS -> print_value (MenhirInterpreter.T T_REPORTS) () + | REPORTING -> print_value (MenhirInterpreter.T T_REPORTING) () + | REPORT -> print_value (MenhirInterpreter.T T_REPORT) () + | REPLACING -> print_value (MenhirInterpreter.T T_REPLACING) () + | REPLACE -> print_value (MenhirInterpreter.T T_REPLACE) () + | REPEATED -> print_value (MenhirInterpreter.T T_REPEATED) () + | REORG_CRITERIA -> print_value (MenhirInterpreter.T T_REORG_CRITERIA) () + | RENAMES -> print_value (MenhirInterpreter.T T_RENAMES) () + | REMOVAL -> print_value (MenhirInterpreter.T T_REMOVAL) () + | REMARKS v -> print_value (MenhirInterpreter.T T_REMARKS) v + | REMAINDER -> print_value (MenhirInterpreter.T T_REMAINDER) () + | RELEASE -> print_value (MenhirInterpreter.T T_RELEASE) () + | RELATIVE -> print_value (MenhirInterpreter.T T_RELATIVE) () + | RELATION -> print_value (MenhirInterpreter.T T_RELATION) () + | REGION_COLOR -> print_value (MenhirInterpreter.T T_REGION_COLOR) () + | REFRESH -> print_value (MenhirInterpreter.T T_REFRESH) () + | REFERENCES -> print_value (MenhirInterpreter.T T_REFERENCES) () + | REFERENCE -> print_value (MenhirInterpreter.T T_REFERENCE) () + | REEL -> print_value (MenhirInterpreter.T T_REEL) () + | REDEFINES -> print_value (MenhirInterpreter.T T_REDEFINES) () + | RECURSIVE -> print_value (MenhirInterpreter.T T_RECURSIVE) () + | RECORD_TO_DELETE -> print_value (MenhirInterpreter.T T_RECORD_TO_DELETE) () + | RECORD_TO_ADD -> print_value (MenhirInterpreter.T T_RECORD_TO_ADD) () + | RECORD_OVERFLOW -> print_value (MenhirInterpreter.T T_RECORD_OVERFLOW) () + | RECORD_DATA -> print_value (MenhirInterpreter.T T_RECORD_DATA) () + | RECORDS -> print_value (MenhirInterpreter.T T_RECORDS) () + | RECORDING -> print_value (MenhirInterpreter.T T_RECORDING) () + | RECORD -> print_value (MenhirInterpreter.T T_RECORD) () + | RECEIVED -> print_value (MenhirInterpreter.T T_RECEIVED) () + | RECEIVE -> print_value (MenhirInterpreter.T T_RECEIVE) () + | READ_ONLY -> print_value (MenhirInterpreter.T T_READ_ONLY) () + | READERS -> print_value (MenhirInterpreter.T T_READERS) () + | READ -> print_value (MenhirInterpreter.T T_READ) () + | RD -> print_value (MenhirInterpreter.T T_RD) () + | RANDOM -> print_value (MenhirInterpreter.T T_RANDOM) () + | RAISING -> print_value (MenhirInterpreter.T T_RAISING) () + | RAISED -> print_value (MenhirInterpreter.T T_RAISED) () + | RAISE -> print_value (MenhirInterpreter.T T_RAISE) () + | RADIO_BUTTON -> print_value (MenhirInterpreter.T T_RADIO_BUTTON) () + | QUOTE -> print_value (MenhirInterpreter.T T_QUOTE) () + | QUEUED -> print_value (MenhirInterpreter.T T_QUEUED) () + | QUEUE -> print_value (MenhirInterpreter.T T_QUEUE) () + | QUERY_INDEX -> print_value (MenhirInterpreter.T T_QUERY_INDEX) () + | PUSH_BUTTON -> print_value (MenhirInterpreter.T T_PUSH_BUTTON) () + | PURGE -> print_value (MenhirInterpreter.T T_PURGE) () + | PROTOTYPE -> print_value (MenhirInterpreter.T T_PROTOTYPE) () + | PROTECTED -> print_value (MenhirInterpreter.T T_PROTECTED) () + | PROPERTY -> print_value (MenhirInterpreter.T T_PROPERTY) () + | PROPERTIES -> print_value (MenhirInterpreter.T T_PROPERTIES) () + | PROMPT -> print_value (MenhirInterpreter.T T_PROMPT) () + | PROHIBITED -> print_value (MenhirInterpreter.T T_PROHIBITED) () + | PROGRESS -> print_value (MenhirInterpreter.T T_PROGRESS) () + | PROGRAM_POINTER -> print_value (MenhirInterpreter.T T_PROGRAM_POINTER) () + | PROGRAM_ID -> print_value (MenhirInterpreter.T T_PROGRAM_ID) () + | PROGRAM -> print_value (MenhirInterpreter.T T_PROGRAM) () + | PROCESS_AREA -> print_value (MenhirInterpreter.T T_PROCESS_AREA) () + | PROCESSING -> print_value (MenhirInterpreter.T T_PROCESSING) () + | PROCEED -> print_value (MenhirInterpreter.T T_PROCEED) () + | PROCEDURE_POINTER -> print_value (MenhirInterpreter.T T_PROCEDURE_POINTER) () + | PROCEDURES -> print_value (MenhirInterpreter.T T_PROCEDURES) () + | PROCEDURE -> print_value (MenhirInterpreter.T T_PROCEDURE) () + | PRIORITY -> print_value (MenhirInterpreter.T T_PRIORITY) () + | PRINT_PREVIEW -> print_value (MenhirInterpreter.T T_PRINT_PREVIEW) () + | PRINT_NO_PROMPT -> print_value (MenhirInterpreter.T T_PRINT_NO_PROMPT) () + | PRINTING -> print_value (MenhirInterpreter.T T_PRINTING) () + | PRINTER_1 -> print_value (MenhirInterpreter.T T_PRINTER_1) () + | PRINTER -> print_value (MenhirInterpreter.T T_PRINTER) () + | PRINT -> print_value (MenhirInterpreter.T T_PRINT) () + | PRIMARY -> print_value (MenhirInterpreter.T T_PRIMARY) () + | PREVIOUS -> print_value (MenhirInterpreter.T T_PREVIOUS) () + | PRESENT -> print_value (MenhirInterpreter.T T_PRESENT) () + | PREFIXED -> print_value (MenhirInterpreter.T T_PREFIXED) () + | POSITIVE -> print_value (MenhirInterpreter.T T_POSITIVE) () + | POSITION_SHIFT -> print_value (MenhirInterpreter.T T_POSITION_SHIFT) () + | POSITION -> print_value (MenhirInterpreter.T T_POSITION) () + | POS -> print_value (MenhirInterpreter.T T_POS) () + | POP_UP -> print_value (MenhirInterpreter.T T_POP_UP) () + | POINTER -> print_value (MenhirInterpreter.T T_POINTER) () + | PLUS_SIGN -> print_value (MenhirInterpreter.T T_PLUS_SIGN) () + | PLUS -> print_value (MenhirInterpreter.T T_PLUS) () + | PLACEMENT -> print_value (MenhirInterpreter.T T_PLACEMENT) () + | PIXEL -> print_value (MenhirInterpreter.T T_PIXEL) () + | PICTURE_STRING v -> print_value (MenhirInterpreter.T T_PICTURE_STRING) v + | PICTURE -> print_value (MenhirInterpreter.T T_PICTURE) () + | PHYSICAL -> print_value (MenhirInterpreter.T T_PHYSICAL) () + | PH -> print_value (MenhirInterpreter.T T_PH) () + | PF -> print_value (MenhirInterpreter.T T_PF) () + | PERMANENT -> print_value (MenhirInterpreter.T T_PERMANENT) () + | PERIOD -> print_value (MenhirInterpreter.T T_PERIOD) () + | PERFORM -> print_value (MenhirInterpreter.T T_PERFORM) () + | PASSWORD -> print_value (MenhirInterpreter.T T_PASSWORD) () + | PASCAL -> print_value (MenhirInterpreter.T T_PASCAL) () + | PARSE -> print_value (MenhirInterpreter.T T_PARSE) () + | PARENT -> print_value (MenhirInterpreter.T T_PARENT) () + | PARAGRAPH -> print_value (MenhirInterpreter.T T_PARAGRAPH) () + | PAGE_SETUP -> print_value (MenhirInterpreter.T T_PAGE_SETUP) () + | PAGE_COUNTER -> print_value (MenhirInterpreter.T T_PAGE_COUNTER) () + | PAGED -> print_value (MenhirInterpreter.T T_PAGED) () + | PAGE -> print_value (MenhirInterpreter.T T_PAGE) () + | PADDING -> print_value (MenhirInterpreter.T T_PADDING) () + | PACKED_DECIMAL -> print_value (MenhirInterpreter.T T_PACKED_DECIMAL) () + | OVERRIDING -> print_value (MenhirInterpreter.T T_OVERRIDING) () + | OVERRIDE -> print_value (MenhirInterpreter.T T_OVERRIDE) () + | OVERLINE -> print_value (MenhirInterpreter.T T_OVERLINE) () + | OVERLAP_TOP -> print_value (MenhirInterpreter.T T_OVERLAP_TOP) () + | OVERLAP_LEFT -> print_value (MenhirInterpreter.T T_OVERLAP_LEFT) () + | OVERFLOW -> print_value (MenhirInterpreter.T T_OVERFLOW) () + | OUTPUT -> print_value (MenhirInterpreter.T T_OUTPUT) () + | OTHERS -> print_value (MenhirInterpreter.T T_OTHERS) () + | OTHER -> print_value (MenhirInterpreter.T T_OTHER) () + | ORGANIZATION -> print_value (MenhirInterpreter.T T_ORGANIZATION) () + | ORDER -> print_value (MenhirInterpreter.T T_ORDER) () + | OR -> print_value (MenhirInterpreter.T T_OR) () + | OPTIONS -> print_value (MenhirInterpreter.T T_OPTIONS) () + | OPTIONAL -> print_value (MenhirInterpreter.T T_OPTIONAL) () + | OPERATIONAL -> print_value (MenhirInterpreter.T T_OPERATIONAL) () + | OPEN -> print_value (MenhirInterpreter.T T_OPEN) () + | ON_SIZE_ERROR -> print_value (MenhirInterpreter.T T_ON_SIZE_ERROR) () + | ON_OVERFLOW -> print_value (MenhirInterpreter.T T_ON_OVERFLOW) () + | ON_EXCEPTION -> print_value (MenhirInterpreter.T T_ON_EXCEPTION) () + | ONLY -> print_value (MenhirInterpreter.T T_ONLY) () + | ON -> print_value (MenhirInterpreter.T T_ON) () + | OMITTED -> print_value (MenhirInterpreter.T T_OMITTED) () + | OK_BUTTON -> print_value (MenhirInterpreter.T T_OK_BUTTON) () + | OFF -> print_value (MenhirInterpreter.T T_OFF) () + | OF -> print_value (MenhirInterpreter.T T_OF) () + | OCCURS -> print_value (MenhirInterpreter.T T_OCCURS) () + | OBJECT_REFERENCE -> print_value (MenhirInterpreter.T T_OBJECT_REFERENCE) () + | OBJECT_PROGRAM -> print_value (MenhirInterpreter.T T_OBJECT_PROGRAM) () + | OBJECT_COMPUTER -> print_value (MenhirInterpreter.T T_OBJECT_COMPUTER) () + | OBJECT -> print_value (MenhirInterpreter.T T_OBJECT) () + | NUM_ROWS -> print_value (MenhirInterpreter.T T_NUM_ROWS) () + | NUM_COL_HEADINGS -> print_value (MenhirInterpreter.T T_NUM_COL_HEADINGS) () + | NUMERIC_EDITED -> print_value (MenhirInterpreter.T T_NUMERIC_EDITED) () + | NUMERIC -> print_value (MenhirInterpreter.T T_NUMERIC) () + | NUMBERS -> print_value (MenhirInterpreter.T T_NUMBERS) () + | NUMBER -> print_value (MenhirInterpreter.T T_NUMBER) () + | NULLS -> print_value (MenhirInterpreter.T T_NULLS) () + | NULLIT v -> print_value (MenhirInterpreter.T T_NULLIT) v + | NULL -> print_value (MenhirInterpreter.T T_NULL) () + | NO_UPDOWN -> print_value (MenhirInterpreter.T T_NO_UPDOWN) () + | NO_SEARCH -> print_value (MenhirInterpreter.T T_NO_SEARCH) () + | NO_KEY_LETTER -> print_value (MenhirInterpreter.T T_NO_KEY_LETTER) () + | NO_GROUP_TAB -> print_value (MenhirInterpreter.T T_NO_GROUP_TAB) () + | NO_FOCUS -> print_value (MenhirInterpreter.T T_NO_FOCUS) () + | NO_F4 -> print_value (MenhirInterpreter.T T_NO_F4) () + | NO_ECHO -> print_value (MenhirInterpreter.T T_NO_ECHO) () + | NO_DIVIDERS -> print_value (MenhirInterpreter.T T_NO_DIVIDERS) () + | NO_DATA -> print_value (MenhirInterpreter.T T_NO_DATA) () + | NO_BOX -> print_value (MenhirInterpreter.T T_NO_BOX) () + | NO_AUTO_DEFAULT -> print_value (MenhirInterpreter.T T_NO_AUTO_DEFAULT) () + | NO_AUTOSEL -> print_value (MenhirInterpreter.T T_NO_AUTOSEL) () + | NOT_ON_SIZE_ERROR -> print_value (MenhirInterpreter.T T_NOT_ON_SIZE_ERROR) () + | NOT_ON_OVERFLOW -> print_value (MenhirInterpreter.T T_NOT_ON_OVERFLOW) () + | NOT_ON_EXCEPTION -> print_value (MenhirInterpreter.T T_NOT_ON_EXCEPTION) () + | NOT_INVALID_KEY -> print_value (MenhirInterpreter.T T_NOT_INVALID_KEY) () + | NOT_AT_EOP -> print_value (MenhirInterpreter.T T_NOT_AT_EOP) () + | NOT_AT_END -> print_value (MenhirInterpreter.T T_NOT_AT_END) () + | NOTIFY_SELCHANGE -> print_value (MenhirInterpreter.T T_NOTIFY_SELCHANGE) () + | NOTIFY_DBLCLICK -> print_value (MenhirInterpreter.T T_NOTIFY_DBLCLICK) () + | NOTIFY_CHANGE -> print_value (MenhirInterpreter.T T_NOTIFY_CHANGE) () + | NOTIFY -> print_value (MenhirInterpreter.T T_NOTIFY) () + | NOTHING -> print_value (MenhirInterpreter.T T_NOTHING) () + | NOTAB -> print_value (MenhirInterpreter.T T_NOTAB) () + | NOT -> print_value (MenhirInterpreter.T T_NOT) () + | NORMAL -> print_value (MenhirInterpreter.T T_NORMAL) () + | NONNUMERIC -> print_value (MenhirInterpreter.T T_NONNUMERIC) () + | NONE -> print_value (MenhirInterpreter.T T_NONE) () + | NOMINAL -> print_value (MenhirInterpreter.T T_NOMINAL) () + | NO -> print_value (MenhirInterpreter.T T_NO) () + | NEXT_PAGE -> print_value (MenhirInterpreter.T T_NEXT_PAGE) () + | NEXT_ITEM -> print_value (MenhirInterpreter.T T_NEXT_ITEM) () + | NEXT -> print_value (MenhirInterpreter.T T_NEXT) () + | NEW -> print_value (MenhirInterpreter.T T_NEW) () + | NESTED -> print_value (MenhirInterpreter.T T_NESTED) () + | NEGATIVE -> print_value (MenhirInterpreter.T T_NEGATIVE) () + | NEAREST_TO_ZERO -> print_value (MenhirInterpreter.T T_NEAREST_TO_ZERO) () + | NEAREST_TOWARD_ZERO -> print_value (MenhirInterpreter.T T_NEAREST_TOWARD_ZERO) () + | NEAREST_EVEN -> print_value (MenhirInterpreter.T T_NEAREST_EVEN) () + | NEAREST_AWAY_FROM_ZERO -> print_value (MenhirInterpreter.T T_NEAREST_AWAY_FROM_ZERO) () + | NE -> print_value (MenhirInterpreter.T T_NE) () + | NAVIGATE_URL -> print_value (MenhirInterpreter.T T_NAVIGATE_URL) () + | NATLIT v -> print_value (MenhirInterpreter.T T_NATLIT) v + | NATIVE -> print_value (MenhirInterpreter.T T_NATIVE) () + | NATIONAL_EDITED -> print_value (MenhirInterpreter.T T_NATIONAL_EDITED) () + | NATIONAL -> print_value (MenhirInterpreter.T T_NATIONAL) () + | NAT -> print_value (MenhirInterpreter.T T_NAT) () + | NAMESPACE_PREFIX -> print_value (MenhirInterpreter.T T_NAMESPACE_PREFIX) () + | NAMESPACE -> print_value (MenhirInterpreter.T T_NAMESPACE) () + | NAMED -> print_value (MenhirInterpreter.T T_NAMED) () + | NAME -> print_value (MenhirInterpreter.T T_NAME) () + | MULTIPLY -> print_value (MenhirInterpreter.T T_MULTIPLY) () + | MULTIPLE -> print_value (MenhirInterpreter.T T_MULTIPLE) () + | MULTILINE -> print_value (MenhirInterpreter.T T_MULTILINE) () + | MOVE -> print_value (MenhirInterpreter.T T_MOVE) () + | MODULES -> print_value (MenhirInterpreter.T T_MODULES) () + | MODIFY -> print_value (MenhirInterpreter.T T_MODIFY) () + | MODE -> print_value (MenhirInterpreter.T T_MODE) () + | MIN_VAL -> print_value (MenhirInterpreter.T T_MIN_VAL) () + | MINUS -> print_value (MenhirInterpreter.T T_MINUS) () + | MICROSECOND_TIME -> print_value (MenhirInterpreter.T T_MICROSECOND_TIME) () + | METHOD_ID -> print_value (MenhirInterpreter.T T_METHOD_ID) () + | METHOD -> print_value (MenhirInterpreter.T T_METHOD) () + | MESSAGE_TAG -> print_value (MenhirInterpreter.T T_MESSAGE_TAG) () + | MESSAGE -> print_value (MenhirInterpreter.T T_MESSAGE) () + | MERGE -> print_value (MenhirInterpreter.T T_MERGE) () + | MENU -> print_value (MenhirInterpreter.T T_MENU) () + | MEMORY -> print_value (MenhirInterpreter.T T_MEMORY) () + | MEDIUM_FONT -> print_value (MenhirInterpreter.T T_MEDIUM_FONT) () + | MAX_VAL -> print_value (MenhirInterpreter.T T_MAX_VAL) () + | MAX_TEXT -> print_value (MenhirInterpreter.T T_MAX_TEXT) () + | MAX_PROGRESS -> print_value (MenhirInterpreter.T T_MAX_PROGRESS) () + | MAX_LINES -> print_value (MenhirInterpreter.T T_MAX_LINES) () + | MASTER_INDEX -> print_value (MenhirInterpreter.T T_MASTER_INDEX) () + | MASS_UPDATE -> print_value (MenhirInterpreter.T T_MASS_UPDATE) () + | MANUAL -> print_value (MenhirInterpreter.T T_MANUAL) () + | MAGNETIC_TAPE -> print_value (MenhirInterpreter.T T_MAGNETIC_TAPE) () + | LT -> print_value (MenhirInterpreter.T T_LT) () + | LPAR -> print_value (MenhirInterpreter.T T_LPAR) () + | LOW_VALUE -> print_value (MenhirInterpreter.T T_LOW_VALUE) () + | LOW_COLOR -> print_value (MenhirInterpreter.T T_LOW_COLOR) () + | LOWLIGHT -> print_value (MenhirInterpreter.T T_LOWLIGHT) () + | LOWERED -> print_value (MenhirInterpreter.T T_LOWERED) () + | LOWER -> print_value (MenhirInterpreter.T T_LOWER) () + | LONG_DATE -> print_value (MenhirInterpreter.T T_LONG_DATE) () + | LOCK_HOLDING -> print_value (MenhirInterpreter.T T_LOCK_HOLDING) () + | LOCKS -> print_value (MenhirInterpreter.T T_LOCKS) () + | LOCK -> print_value (MenhirInterpreter.T T_LOCK) () + | LOCATION -> print_value (MenhirInterpreter.T T_LOCATION) () + | LOCAL_STORAGE -> print_value (MenhirInterpreter.T T_LOCAL_STORAGE) () + | LOCALE -> print_value (MenhirInterpreter.T T_LOCALE) () + | LOC -> print_value (MenhirInterpreter.T T_LOC) () + | LM_RESIZE -> print_value (MenhirInterpreter.T T_LM_RESIZE) () + | LIST_BOX -> print_value (MenhirInterpreter.T T_LIST_BOX) () + | LINKAGE -> print_value (MenhirInterpreter.T T_LINKAGE) () + | LINE_SEQUENTIAL -> print_value (MenhirInterpreter.T T_LINE_SEQUENTIAL) () + | LINE_COUNTER -> print_value (MenhirInterpreter.T T_LINE_COUNTER) () + | LINES_PER_PAGE -> print_value (MenhirInterpreter.T T_LINES_PER_PAGE) () + | LINES_AT_ROOT -> print_value (MenhirInterpreter.T T_LINES_AT_ROOT) () + | LINES -> print_value (MenhirInterpreter.T T_LINES) () + | LINE -> print_value (MenhirInterpreter.T T_LINE) () + | LINAGE_COUNTER -> print_value (MenhirInterpreter.T T_LINAGE_COUNTER) () + | LINAGE -> print_value (MenhirInterpreter.T T_LINAGE) () + | LIMITS -> print_value (MenhirInterpreter.T T_LIMITS) () + | LIMIT -> print_value (MenhirInterpreter.T T_LIMIT) () + | LIKE -> print_value (MenhirInterpreter.T T_LIKE) () + | LIBRARY -> print_value (MenhirInterpreter.T T_LIBRARY) () + | LESS -> print_value (MenhirInterpreter.T T_LESS) () + | LENGTH -> print_value (MenhirInterpreter.T T_LENGTH) () + | LEFT_TEXT -> print_value (MenhirInterpreter.T T_LEFT_TEXT) () + | LEFT_JUSTIFY -> print_value (MenhirInterpreter.T T_LEFT_JUSTIFY) () + | LEFTLINE -> print_value (MenhirInterpreter.T T_LEFTLINE) () + | LEFT -> print_value (MenhirInterpreter.T T_LEFT) () + | LEAVE -> print_value (MenhirInterpreter.T T_LEAVE) () + | LEADING_SHIFT -> print_value (MenhirInterpreter.T T_LEADING_SHIFT) () + | LEADING -> print_value (MenhirInterpreter.T T_LEADING) () + | LE -> print_value (MenhirInterpreter.T T_LE) () + | LC_TIME -> print_value (MenhirInterpreter.T T_LC_TIME) () + | LC_NUMERIC -> print_value (MenhirInterpreter.T T_LC_NUMERIC) () + | LC_MONETARY -> print_value (MenhirInterpreter.T T_LC_MONETARY) () + | LC_MESSAGES -> print_value (MenhirInterpreter.T T_LC_MESSAGES) () + | LC_CTYPE -> print_value (MenhirInterpreter.T T_LC_CTYPE) () + | LC_COLLATE -> print_value (MenhirInterpreter.T T_LC_COLLATE) () + | LC_ALL -> print_value (MenhirInterpreter.T T_LC_ALL) () + | LAYOUT_MANAGER -> print_value (MenhirInterpreter.T T_LAYOUT_MANAGER) () + | LAYOUT_DATA -> print_value (MenhirInterpreter.T T_LAYOUT_DATA) () + | LAST_ROW -> print_value (MenhirInterpreter.T T_LAST_ROW) () + | LAST -> print_value (MenhirInterpreter.T T_LAST) () + | LARGE_OFFSET -> print_value (MenhirInterpreter.T T_LARGE_OFFSET) () + | LARGE_FONT -> print_value (MenhirInterpreter.T T_LARGE_FONT) () + | LABEL_OFFSET -> print_value (MenhirInterpreter.T T_LABEL_OFFSET) () + | LABEL -> print_value (MenhirInterpreter.T T_LABEL) () + | KEY_LOCATION -> print_value (MenhirInterpreter.T T_KEY_LOCATION) () + | KEYED -> print_value (MenhirInterpreter.T T_KEYED) () + | KEYBOARD -> print_value (MenhirInterpreter.T T_KEYBOARD) () + | KEY -> print_value (MenhirInterpreter.T T_KEY) () + | KEPT -> print_value (MenhirInterpreter.T T_KEPT) () + | JUSTIFIED -> print_value (MenhirInterpreter.T T_JUSTIFIED) () + | JSON -> print_value (MenhirInterpreter.T T_JSON) () + | I_O_CONTROL -> print_value (MenhirInterpreter.T T_I_O_CONTROL) () + | I_O -> print_value (MenhirInterpreter.T T_I_O) () + | ITEM_VALUE -> print_value (MenhirInterpreter.T T_ITEM_VALUE) () + | ITEM_TO_EMPTY -> print_value (MenhirInterpreter.T T_ITEM_TO_EMPTY) () + | ITEM_TO_DELETE -> print_value (MenhirInterpreter.T T_ITEM_TO_DELETE) () + | ITEM_TO_ADD -> print_value (MenhirInterpreter.T T_ITEM_TO_ADD) () + | ITEM_TEXT -> print_value (MenhirInterpreter.T T_ITEM_TEXT) () + | ITEM -> print_value (MenhirInterpreter.T T_ITEM) () + | IS_TYPEDEF -> print_value (MenhirInterpreter.T T_IS_TYPEDEF) () + | IS_GLOBAL -> print_value (MenhirInterpreter.T T_IS_GLOBAL) () + | IS_EXTERNAL -> print_value (MenhirInterpreter.T T_IS_EXTERNAL) () + | IS -> print_value (MenhirInterpreter.T T_IS) () + | IN_ARITHMETIC_RANGE -> print_value (MenhirInterpreter.T T_IN_ARITHMETIC_RANGE) () + | INVOKING -> print_value (MenhirInterpreter.T T_INVOKING) () + | INVOKE -> print_value (MenhirInterpreter.T T_INVOKE) () + | INVALID_KEY -> print_value (MenhirInterpreter.T T_INVALID_KEY) () + | INVALID -> print_value (MenhirInterpreter.T T_INVALID) () + | INTRINSIC -> print_value (MenhirInterpreter.T T_INTRINSIC) () + | INTO -> print_value (MenhirInterpreter.T T_INTO) () + | INTERVENING_ v -> print_value (MenhirInterpreter.T T_INTERVENING_) v + | INTERMEDIATE -> print_value (MenhirInterpreter.T T_INTERMEDIATE) () + | INTERFACE_ID -> print_value (MenhirInterpreter.T T_INTERFACE_ID) () + | INTERFACE -> print_value (MenhirInterpreter.T T_INTERFACE) () + | INSTALLATION v -> print_value (MenhirInterpreter.T T_INSTALLATION) v + | INSPECT -> print_value (MenhirInterpreter.T T_INSPECT) () + | INSERT_ROWS -> print_value (MenhirInterpreter.T T_INSERT_ROWS) () + | INSERTION_INDEX -> print_value (MenhirInterpreter.T T_INSERTION_INDEX) () + | INQUIRE -> print_value (MenhirInterpreter.T T_INQUIRE) () + | INPUT_OUTPUT -> print_value (MenhirInterpreter.T T_INPUT_OUTPUT) () + | INPUT -> print_value (MenhirInterpreter.T T_INPUT) () + | INITIATE -> print_value (MenhirInterpreter.T T_INITIATE) () + | INITIALIZED -> print_value (MenhirInterpreter.T T_INITIALIZED) () + | INITIALIZE -> print_value (MenhirInterpreter.T T_INITIALIZE) () + | INITIAL -> print_value (MenhirInterpreter.T T_INITIAL) () + | INHERITS -> print_value (MenhirInterpreter.T T_INHERITS) () + | INDICATE -> print_value (MenhirInterpreter.T T_INDICATE) () + | INDEX_2 -> print_value (MenhirInterpreter.T T_INDEX_2) () + | INDEX_1 -> print_value (MenhirInterpreter.T T_INDEX_1) () + | INDEXED -> print_value (MenhirInterpreter.T T_INDEXED) () + | INDEX -> print_value (MenhirInterpreter.T T_INDEX) () + | INDEPENDENT -> print_value (MenhirInterpreter.T T_INDEPENDENT) () + | IN -> print_value (MenhirInterpreter.T T_IN) () + | IMPLEMENTS -> print_value (MenhirInterpreter.T T_IMPLEMENTS) () + | IGNORING -> print_value (MenhirInterpreter.T T_IGNORING) () + | IGNORE -> print_value (MenhirInterpreter.T T_IGNORE) () + | IF -> print_value (MenhirInterpreter.T T_IF) () + | IDS_II -> print_value (MenhirInterpreter.T T_IDS_II) () + | IDENTIFIED -> print_value (MenhirInterpreter.T T_IDENTIFIED) () + | IDENTIFICATION -> print_value (MenhirInterpreter.T T_IDENTIFICATION) () + | ID -> print_value (MenhirInterpreter.T T_ID) () + | ICON -> print_value (MenhirInterpreter.T T_ICON) () + | HSCROLL_POS -> print_value (MenhirInterpreter.T T_HSCROLL_POS) () + | HSCROLL -> print_value (MenhirInterpreter.T T_HSCROLL) () + | HOT_TRACK -> print_value (MenhirInterpreter.T T_HOT_TRACK) () + | HIGH_VALUE -> print_value (MenhirInterpreter.T T_HIGH_VALUE) () + | HIGH_ORDER_RIGHT -> print_value (MenhirInterpreter.T T_HIGH_ORDER_RIGHT) () + | HIGH_ORDER_LEFT -> print_value (MenhirInterpreter.T T_HIGH_ORDER_LEFT) () + | HIGH_COLOR -> print_value (MenhirInterpreter.T T_HIGH_COLOR) () + | HIGHLIGHT -> print_value (MenhirInterpreter.T T_HIGHLIGHT) () + | HIDDEN_DATA -> print_value (MenhirInterpreter.T T_HIDDEN_DATA) () + | HEXLIT v -> print_value (MenhirInterpreter.T T_HEXLIT) v + | HEX -> print_value (MenhirInterpreter.T T_HEX) () + | HEIGHT_IN_CELLS -> print_value (MenhirInterpreter.T T_HEIGHT_IN_CELLS) () + | HEAVY -> print_value (MenhirInterpreter.T T_HEAVY) () + | HEADING_FONT -> print_value (MenhirInterpreter.T T_HEADING_FONT) () + | HEADING_DIVIDER_COLOR -> print_value (MenhirInterpreter.T T_HEADING_DIVIDER_COLOR) () + | HEADING_COLOR -> print_value (MenhirInterpreter.T T_HEADING_COLOR) () + | HEADING -> print_value (MenhirInterpreter.T T_HEADING) () + | HAS_CHILDREN -> print_value (MenhirInterpreter.T T_HAS_CHILDREN) () + | HANDLE -> print_value (MenhirInterpreter.T T_HANDLE) () + | GT -> print_value (MenhirInterpreter.T T_GT) () + | GROUP_VALUE -> print_value (MenhirInterpreter.T T_GROUP_VALUE) () + | GROUP_USAGE -> print_value (MenhirInterpreter.T T_GROUP_USAGE) () + | GROUP -> print_value (MenhirInterpreter.T T_GROUP) () + | GRID -> print_value (MenhirInterpreter.T T_GRID) () + | GREATER -> print_value (MenhirInterpreter.T T_GREATER) () + | GRAPHICAL -> print_value (MenhirInterpreter.T T_GRAPHICAL) () + | GO_SEARCH -> print_value (MenhirInterpreter.T T_GO_SEARCH) () + | GO_HOME -> print_value (MenhirInterpreter.T T_GO_HOME) () + | GO_FORWARD -> print_value (MenhirInterpreter.T T_GO_FORWARD) () + | GO_BACK -> print_value (MenhirInterpreter.T T_GO_BACK) () + | GOBACK -> print_value (MenhirInterpreter.T T_GOBACK) () + | GO -> print_value (MenhirInterpreter.T T_GO) () + | GLOBAL -> print_value (MenhirInterpreter.T T_GLOBAL) () + | GIVING -> print_value (MenhirInterpreter.T T_GIVING) () + | GET -> print_value (MenhirInterpreter.T T_GET) () + | GENERATE -> print_value (MenhirInterpreter.T T_GENERATE) () + | GE -> print_value (MenhirInterpreter.T T_GE) () + | GCOS -> print_value (MenhirInterpreter.T T_GCOS) () + | FUNCTION_POINTER -> print_value (MenhirInterpreter.T T_FUNCTION_POINTER) () + | FUNCTION_ID -> print_value (MenhirInterpreter.T T_FUNCTION_ID) () + | FUNCTION -> print_value (MenhirInterpreter.T T_FUNCTION) () + | FULL_HEIGHT -> print_value (MenhirInterpreter.T T_FULL_HEIGHT) () + | FULL -> print_value (MenhirInterpreter.T T_FULL) () + | FROM -> print_value (MenhirInterpreter.T T_FROM) () + | FREE -> print_value (MenhirInterpreter.T T_FREE) () + | FRAMED -> print_value (MenhirInterpreter.T T_FRAMED) () + | FRAME -> print_value (MenhirInterpreter.T T_FRAME) () + | FORMAT -> print_value (MenhirInterpreter.T T_FORMAT) () + | FOREVER -> print_value (MenhirInterpreter.T T_FOREVER) () + | FOREGROUND_COLOR -> print_value (MenhirInterpreter.T T_FOREGROUND_COLOR) () + | FOR -> print_value (MenhirInterpreter.T T_FOR) () + | FOOTING -> print_value (MenhirInterpreter.T T_FOOTING) () + | FONT -> print_value (MenhirInterpreter.T T_FONT) () + | FLR -> print_value (MenhirInterpreter.T T_FLR) () + | FLOAT_SHORT -> print_value (MenhirInterpreter.T T_FLOAT_SHORT) () + | FLOAT_NOT_A_NUMBER_SIGNALING -> print_value (MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_SIGNALING) () + | FLOAT_NOT_A_NUMBER_QUIET -> print_value (MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_QUIET) () + | FLOAT_NOT_A_NUMBER -> print_value (MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER) () + | FLOAT_LONG -> print_value (MenhirInterpreter.T T_FLOAT_LONG) () + | FLOAT_INFINITY -> print_value (MenhirInterpreter.T T_FLOAT_INFINITY) () + | FLOAT_EXTENDED -> print_value (MenhirInterpreter.T T_FLOAT_EXTENDED) () + | FLOAT_DECIMAL_34 -> print_value (MenhirInterpreter.T T_FLOAT_DECIMAL_34) () + | FLOAT_DECIMAL_16 -> print_value (MenhirInterpreter.T T_FLOAT_DECIMAL_16) () + | FLOAT_DECIMAL -> print_value (MenhirInterpreter.T T_FLOAT_DECIMAL) () + | FLOAT_BINARY_64 -> print_value (MenhirInterpreter.T T_FLOAT_BINARY_64) () + | FLOAT_BINARY_32 -> print_value (MenhirInterpreter.T T_FLOAT_BINARY_32) () + | FLOAT_BINARY_128 -> print_value (MenhirInterpreter.T T_FLOAT_BINARY_128) () + | FLOAT_BINARY -> print_value (MenhirInterpreter.T T_FLOAT_BINARY) () + | FLOATLIT v -> print_value (MenhirInterpreter.T T_FLOATLIT) v + | FLOATING -> print_value (MenhirInterpreter.T T_FLOATING) () + | FLOAT -> print_value (MenhirInterpreter.T T_FLOAT) () + | FLAT_BUTTONS -> print_value (MenhirInterpreter.T T_FLAT_BUTTONS) () + | FLAT -> print_value (MenhirInterpreter.T T_FLAT) () + | FIXED_WIDTH -> print_value (MenhirInterpreter.T T_FIXED_WIDTH) () + | FIXED_FONT -> print_value (MenhirInterpreter.T T_FIXED_FONT) () + | FIXEDLIT v -> print_value (MenhirInterpreter.T T_FIXEDLIT) v + | FIXED -> print_value (MenhirInterpreter.T T_FIXED) () + | FIRST -> print_value (MenhirInterpreter.T T_FIRST) () + | FINISH_REASON -> print_value (MenhirInterpreter.T T_FINISH_REASON) () + | FINALLY -> print_value (MenhirInterpreter.T T_FINALLY) () + | FINAL -> print_value (MenhirInterpreter.T T_FINAL) () + | FILL_PERCENT -> print_value (MenhirInterpreter.T T_FILL_PERCENT) () + | FILL_COLOR2 -> print_value (MenhirInterpreter.T T_FILL_COLOR2) () + | FILL_COLOR -> print_value (MenhirInterpreter.T T_FILL_COLOR) () + | FILLER -> print_value (MenhirInterpreter.T T_FILLER) () + | FILE_POS -> print_value (MenhirInterpreter.T T_FILE_POS) () + | FILE_NAME -> print_value (MenhirInterpreter.T T_FILE_NAME) () + | FILE_LIMITS -> print_value (MenhirInterpreter.T T_FILE_LIMITS) () + | FILE_LIMIT -> print_value (MenhirInterpreter.T T_FILE_LIMIT) () + | FILE_ID -> print_value (MenhirInterpreter.T T_FILE_ID) () + | FILE_CONTROL -> print_value (MenhirInterpreter.T T_FILE_CONTROL) () + | FILES -> print_value (MenhirInterpreter.T T_FILES) () + | FILE -> print_value (MenhirInterpreter.T T_FILE) () + | FH__KEYDEF -> print_value (MenhirInterpreter.T T_FH__KEYDEF) () + | FH__FCD -> print_value (MenhirInterpreter.T T_FH__FCD) () + | FD -> print_value (MenhirInterpreter.T T_FD) () + | FARTHEST_FROM_ZERO -> print_value (MenhirInterpreter.T T_FARTHEST_FROM_ZERO) () + | FALSE -> print_value (MenhirInterpreter.T T_FALSE) () + | FACTORY -> print_value (MenhirInterpreter.T T_FACTORY) () + | F -> print_value (MenhirInterpreter.T T_F) () + | EXTERNAL_FORM -> print_value (MenhirInterpreter.T T_EXTERNAL_FORM) () + | EXTERNAL -> print_value (MenhirInterpreter.T T_EXTERNAL) () + | EXTERN -> print_value (MenhirInterpreter.T T_EXTERN) () + | EXTENDED_SEARCH -> print_value (MenhirInterpreter.T T_EXTENDED_SEARCH) () + | EXTEND -> print_value (MenhirInterpreter.T T_EXTEND) () + | EXPANDS -> print_value (MenhirInterpreter.T T_EXPANDS) () + | EXPAND -> print_value (MenhirInterpreter.T T_EXPAND) () + | EXIT -> print_value (MenhirInterpreter.T T_EXIT) () + | EXHIBIT -> print_value (MenhirInterpreter.T T_EXHIBIT) () + | EXCLUSIVE_OR -> print_value (MenhirInterpreter.T T_EXCLUSIVE_OR) () + | EXCLUSIVE -> print_value (MenhirInterpreter.T T_EXCLUSIVE) () + | EXCEPTION_VALUE -> print_value (MenhirInterpreter.T T_EXCEPTION_VALUE) () + | EXCEPTION_OBJECT -> print_value (MenhirInterpreter.T T_EXCEPTION_OBJECT) () + | EXCEPTION -> print_value (MenhirInterpreter.T T_EXCEPTION) () + | EXAMINE -> print_value (MenhirInterpreter.T T_EXAMINE) () + | EVERY -> print_value (MenhirInterpreter.T T_EVERY) () + | EVENT_LIST -> print_value (MenhirInterpreter.T T_EVENT_LIST) () + | EVENT -> print_value (MenhirInterpreter.T T_EVENT) () + | EVALUATE -> print_value (MenhirInterpreter.T T_EVALUATE) () + | ESI -> print_value (MenhirInterpreter.T T_ESI) () + | ESCAPE_BUTTON -> print_value (MenhirInterpreter.T T_ESCAPE_BUTTON) () + | ESCAPE -> print_value (MenhirInterpreter.T T_ESCAPE) () + | ERROR -> print_value (MenhirInterpreter.T T_ERROR) () + | ERASE -> print_value (MenhirInterpreter.T T_ERASE) () + | EQUAL -> print_value (MenhirInterpreter.T T_EQUAL) () + | EQ -> print_value (MenhirInterpreter.T T_EQ) () + | EOS -> print_value (MenhirInterpreter.T T_EOS) () + | EOP -> print_value (MenhirInterpreter.T T_EOP) () + | EOL -> print_value (MenhirInterpreter.T T_EOL) () + | EOF -> print_value (MenhirInterpreter.T T_EOF) () + | EO -> print_value (MenhirInterpreter.T T_EO) () + | ENVIRONMENT_VALUE -> print_value (MenhirInterpreter.T T_ENVIRONMENT_VALUE) () + | ENVIRONMENT_NAME -> print_value (MenhirInterpreter.T T_ENVIRONMENT_NAME) () + | ENVIRONMENT -> print_value (MenhirInterpreter.T T_ENVIRONMENT) () + | ENTRY_REASON -> print_value (MenhirInterpreter.T T_ENTRY_REASON) () + | ENTRY_FIELD -> print_value (MenhirInterpreter.T T_ENTRY_FIELD) () + | ENTRY_CONVENTION -> print_value (MenhirInterpreter.T T_ENTRY_CONVENTION) () + | ENTRY -> print_value (MenhirInterpreter.T T_ENTRY) () + | ENTER -> print_value (MenhirInterpreter.T T_ENTER) () + | ENSURE_VISIBLE -> print_value (MenhirInterpreter.T T_ENSURE_VISIBLE) () + | ENGRAVED -> print_value (MenhirInterpreter.T T_ENGRAVED) () + | END_XML -> print_value (MenhirInterpreter.T T_END_XML) () + | END_WRITE -> print_value (MenhirInterpreter.T T_END_WRITE) () + | END_UNSTRING -> print_value (MenhirInterpreter.T T_END_UNSTRING) () + | END_SUBTRACT -> print_value (MenhirInterpreter.T T_END_SUBTRACT) () + | END_STRING -> print_value (MenhirInterpreter.T T_END_STRING) () + | END_START -> print_value (MenhirInterpreter.T T_END_START) () + | END_SEND -> print_value (MenhirInterpreter.T T_END_SEND) () + | END_SEARCH -> print_value (MenhirInterpreter.T T_END_SEARCH) () + | END_REWRITE -> print_value (MenhirInterpreter.T T_END_REWRITE) () + | END_RETURN -> print_value (MenhirInterpreter.T T_END_RETURN) () + | END_RECEIVE -> print_value (MenhirInterpreter.T T_END_RECEIVE) () + | END_READ -> print_value (MenhirInterpreter.T T_END_READ) () + | END_PERFORM -> print_value (MenhirInterpreter.T T_END_PERFORM) () + | END_OF_PAGE -> print_value (MenhirInterpreter.T T_END_OF_PAGE) () + | END_MULTIPLY -> print_value (MenhirInterpreter.T T_END_MULTIPLY) () + | END_MODIFY -> print_value (MenhirInterpreter.T T_END_MODIFY) () + | END_JSON -> print_value (MenhirInterpreter.T T_END_JSON) () + | END_IF -> print_value (MenhirInterpreter.T T_END_IF) () + | END_EVALUATE -> print_value (MenhirInterpreter.T T_END_EVALUATE) () + | END_DIVIDE -> print_value (MenhirInterpreter.T T_END_DIVIDE) () + | END_DISPLAY -> print_value (MenhirInterpreter.T T_END_DISPLAY) () + | END_DELETE -> print_value (MenhirInterpreter.T T_END_DELETE) () + | END_COMPUTE -> print_value (MenhirInterpreter.T T_END_COMPUTE) () + | END_COLOR -> print_value (MenhirInterpreter.T T_END_COLOR) () + | END_CHAIN -> print_value (MenhirInterpreter.T T_END_CHAIN) () + | END_CALL -> print_value (MenhirInterpreter.T T_END_CALL) () + | END_ADD -> print_value (MenhirInterpreter.T T_END_ADD) () + | END_ACCEPT -> print_value (MenhirInterpreter.T T_END_ACCEPT) () + | ENDING -> print_value (MenhirInterpreter.T T_ENDING) () + | END -> print_value (MenhirInterpreter.T T_END) () + | ENCRYPTION -> print_value (MenhirInterpreter.T T_ENCRYPTION) () + | ENCODING -> print_value (MenhirInterpreter.T T_ENCODING) () + | ENABLE -> print_value (MenhirInterpreter.T T_ENABLE) () + | EMI -> print_value (MenhirInterpreter.T T_EMI) () + | ELSE -> print_value (MenhirInterpreter.T T_ELSE) () + | ELEMENT -> print_value (MenhirInterpreter.T T_ELEMENT) () + | EIGHTY_EIGHT -> print_value (MenhirInterpreter.T T_EIGHTY_EIGHT) () + | EGI -> print_value (MenhirInterpreter.T T_EGI) () + | EDITING -> print_value (MenhirInterpreter.T T_EDITING) () + | ECHO -> print_value (MenhirInterpreter.T T_ECHO) () + | EC -> print_value (MenhirInterpreter.T T_EC) () + | EBCDIC -> print_value (MenhirInterpreter.T T_EBCDIC) () + | DYNAMIC -> print_value (MenhirInterpreter.T T_DYNAMIC) () + | DUPLICATES -> print_value (MenhirInterpreter.T T_DUPLICATES) () + | DROP_LIST -> print_value (MenhirInterpreter.T T_DROP_LIST) () + | DROP_DOWN -> print_value (MenhirInterpreter.T T_DROP_DOWN) () + | DRAG_COLOR -> print_value (MenhirInterpreter.T T_DRAG_COLOR) () + | DOWN -> print_value (MenhirInterpreter.T T_DOWN) () + | DOUBLE_COLON -> print_value (MenhirInterpreter.T T_DOUBLE_COLON) () + | DOUBLE_ASTERISK -> print_value (MenhirInterpreter.T T_DOUBLE_ASTERISK) () + | DOUBLE -> print_value (MenhirInterpreter.T T_DOUBLE) () + | DOTTED -> print_value (MenhirInterpreter.T T_DOTTED) () + | DOTDASH -> print_value (MenhirInterpreter.T T_DOTDASH) () + | DIVISION -> print_value (MenhirInterpreter.T T_DIVISION) () + | DIVIDER_COLOR -> print_value (MenhirInterpreter.T T_DIVIDER_COLOR) () + | DIVIDERS -> print_value (MenhirInterpreter.T T_DIVIDERS) () + | DIVIDE -> print_value (MenhirInterpreter.T T_DIVIDE) () + | DISPLAY_FORMAT -> print_value (MenhirInterpreter.T T_DISPLAY_FORMAT) () + | DISPLAY_COLUMNS -> print_value (MenhirInterpreter.T T_DISPLAY_COLUMNS) () + | DISPLAY_4 -> print_value (MenhirInterpreter.T T_DISPLAY_4) () + | DISPLAY_3 -> print_value (MenhirInterpreter.T T_DISPLAY_3) () + | DISPLAY_2 -> print_value (MenhirInterpreter.T T_DISPLAY_2) () + | DISPLAY_1 -> print_value (MenhirInterpreter.T T_DISPLAY_1) () + | DISPLAY -> print_value (MenhirInterpreter.T T_DISPLAY) () + | DISP -> print_value (MenhirInterpreter.T T_DISP) () + | DISK -> print_value (MenhirInterpreter.T T_DISK) () + | DISCONNECT -> print_value (MenhirInterpreter.T T_DISCONNECT) () + | DISC -> print_value (MenhirInterpreter.T T_DISC) () + | DISABLE -> print_value (MenhirInterpreter.T T_DISABLE) () + | DIGITS v -> print_value (MenhirInterpreter.T T_DIGITS) v + | DETAIL -> print_value (MenhirInterpreter.T T_DETAIL) () + | DESTROY -> print_value (MenhirInterpreter.T T_DESTROY) () + | DESTINATION -> print_value (MenhirInterpreter.T T_DESTINATION) () + | DESCENDING -> print_value (MenhirInterpreter.T T_DESCENDING) () + | DEPENDING -> print_value (MenhirInterpreter.T T_DEPENDING) () + | DELIMITER -> print_value (MenhirInterpreter.T T_DELIMITER) () + | DELIMITED -> print_value (MenhirInterpreter.T T_DELIMITED) () + | DELETE -> print_value (MenhirInterpreter.T T_DELETE) () + | DEFINITION -> print_value (MenhirInterpreter.T T_DEFINITION) () + | DEFAULT_FONT -> print_value (MenhirInterpreter.T T_DEFAULT_FONT) () + | DEFAULT_BUTTON -> print_value (MenhirInterpreter.T T_DEFAULT_BUTTON) () + | DEFAULT -> print_value (MenhirInterpreter.T T_DEFAULT) () + | DECLARATIVES -> print_value (MenhirInterpreter.T T_DECLARATIVES) () + | DECIMAL_POINT -> print_value (MenhirInterpreter.T T_DECIMAL_POINT) () + | DECIMAL_ENCODING -> print_value (MenhirInterpreter.T T_DECIMAL_ENCODING) () + | DEBUG_SUB_3 -> print_value (MenhirInterpreter.T T_DEBUG_SUB_3) () + | DEBUG_SUB_2 -> print_value (MenhirInterpreter.T T_DEBUG_SUB_2) () + | DEBUG_SUB_1 -> print_value (MenhirInterpreter.T T_DEBUG_SUB_1) () + | DEBUG_NAME -> print_value (MenhirInterpreter.T T_DEBUG_NAME) () + | DEBUG_LINE -> print_value (MenhirInterpreter.T T_DEBUG_LINE) () + | DEBUG_ITEM -> print_value (MenhirInterpreter.T T_DEBUG_ITEM) () + | DEBUG_CONTENTS -> print_value (MenhirInterpreter.T T_DEBUG_CONTENTS) () + | DEBUGGING -> print_value (MenhirInterpreter.T T_DEBUGGING) () + | DAY_OF_WEEK -> print_value (MenhirInterpreter.T T_DAY_OF_WEEK) () + | DAY -> print_value (MenhirInterpreter.T T_DAY) () + | DATE_WRITTEN v -> print_value (MenhirInterpreter.T T_DATE_WRITTEN) v + | DATE_MODIFIED v -> print_value (MenhirInterpreter.T T_DATE_MODIFIED) v + | DATE_ENTRY -> print_value (MenhirInterpreter.T T_DATE_ENTRY) () + | DATE_COMPILED v -> print_value (MenhirInterpreter.T T_DATE_COMPILED) v + | DATE -> print_value (MenhirInterpreter.T T_DATE) () + | DATA_TYPES -> print_value (MenhirInterpreter.T T_DATA_TYPES) () + | DATA_RECORDS -> print_value (MenhirInterpreter.T T_DATA_RECORDS) () + | DATA_RECORD -> print_value (MenhirInterpreter.T T_DATA_RECORD) () + | DATA_POINTER -> print_value (MenhirInterpreter.T T_DATA_POINTER) () + | DATA_COLUMNS -> print_value (MenhirInterpreter.T T_DATA_COLUMNS) () + | DATA -> print_value (MenhirInterpreter.T T_DATA) () + | DASH_SIGN -> print_value (MenhirInterpreter.T T_DASH_SIGN) () + | DASHED -> print_value (MenhirInterpreter.T T_DASHED) () + | CYL_OVERFLOW -> print_value (MenhirInterpreter.T T_CYL_OVERFLOW) () + | CYL_INDEX -> print_value (MenhirInterpreter.T T_CYL_INDEX) () + | CYCLE -> print_value (MenhirInterpreter.T T_CYCLE) () + | CUSTOM_PRINT_TEMPLATE -> print_value (MenhirInterpreter.T T_CUSTOM_PRINT_TEMPLATE) () + | CURSOR_Y -> print_value (MenhirInterpreter.T T_CURSOR_Y) () + | CURSOR_X -> print_value (MenhirInterpreter.T T_CURSOR_X) () + | CURSOR_ROW -> print_value (MenhirInterpreter.T T_CURSOR_ROW) () + | CURSOR_FRAME_WIDTH -> print_value (MenhirInterpreter.T T_CURSOR_FRAME_WIDTH) () + | CURSOR_COLOR -> print_value (MenhirInterpreter.T T_CURSOR_COLOR) () + | CURSOR_COL -> print_value (MenhirInterpreter.T T_CURSOR_COL) () + | CURSOR -> print_value (MenhirInterpreter.T T_CURSOR) () + | CURRENT -> print_value (MenhirInterpreter.T T_CURRENT) () + | CURRENCY -> print_value (MenhirInterpreter.T T_CURRENCY) () + | CS_GENERAL -> print_value (MenhirInterpreter.T T_CS_GENERAL) () + | CS_BASIC -> print_value (MenhirInterpreter.T T_CS_BASIC) () + | CSIZE -> print_value (MenhirInterpreter.T T_CSIZE) () + | CRT_UNDER -> print_value (MenhirInterpreter.T T_CRT_UNDER) () + | CRT -> print_value (MenhirInterpreter.T T_CRT) () + | COUNT -> print_value (MenhirInterpreter.T T_COUNT) () + | CORRESPONDING -> print_value (MenhirInterpreter.T T_CORRESPONDING) () + | CORE_INDEX -> print_value (MenhirInterpreter.T T_CORE_INDEX) () + | COPY_SELECTION -> print_value (MenhirInterpreter.T T_COPY_SELECTION) () + | COPY -> print_value (MenhirInterpreter.T T_COPY) () + | CONVERTING -> print_value (MenhirInterpreter.T T_CONVERTING) () + | CONVERSION -> print_value (MenhirInterpreter.T T_CONVERSION) () + | CONTROLS -> print_value (MenhirInterpreter.T T_CONTROLS) () + | CONTROL -> print_value (MenhirInterpreter.T T_CONTROL) () + | CONTINUE -> print_value (MenhirInterpreter.T T_CONTINUE) () + | CONTENT -> print_value (MenhirInterpreter.T T_CONTENT) () + | CONTAINS -> print_value (MenhirInterpreter.T T_CONTAINS) () + | CONSTANT -> print_value (MenhirInterpreter.T T_CONSTANT) () + | CONSOLE_3 -> print_value (MenhirInterpreter.T T_CONSOLE_3) () + | CONSOLE_2 -> print_value (MenhirInterpreter.T T_CONSOLE_2) () + | CONSOLE_1 -> print_value (MenhirInterpreter.T T_CONSOLE_1) () + | CONSOLE_0 -> print_value (MenhirInterpreter.T T_CONSOLE_0) () + | CONNECT -> print_value (MenhirInterpreter.T T_CONNECT) () + | CONFIGURATION -> print_value (MenhirInterpreter.T T_CONFIGURATION) () + | CONDITION -> print_value (MenhirInterpreter.T T_CONDITION) () + | COMP_X -> print_value (MenhirInterpreter.T T_COMP_X) () + | COMP_N -> print_value (MenhirInterpreter.T T_COMP_N) () + | COMP_9 -> print_value (MenhirInterpreter.T T_COMP_9) () + | COMP_7 -> print_value (MenhirInterpreter.T T_COMP_7) () + | COMP_6 -> print_value (MenhirInterpreter.T T_COMP_6) () + | COMP_5 -> print_value (MenhirInterpreter.T T_COMP_5) () + | COMP_4 -> print_value (MenhirInterpreter.T T_COMP_4) () + | COMP_3 -> print_value (MenhirInterpreter.T T_COMP_3) () + | COMP_2 -> print_value (MenhirInterpreter.T T_COMP_2) () + | COMP_15 -> print_value (MenhirInterpreter.T T_COMP_15) () + | COMP_14 -> print_value (MenhirInterpreter.T T_COMP_14) () + | COMP_13 -> print_value (MenhirInterpreter.T T_COMP_13) () + | COMP_12 -> print_value (MenhirInterpreter.T T_COMP_12) () + | COMP_11 -> print_value (MenhirInterpreter.T T_COMP_11) () + | COMP_10 -> print_value (MenhirInterpreter.T T_COMP_10) () + | COMP_1 -> print_value (MenhirInterpreter.T T_COMP_1) () + | COMP_0 -> print_value (MenhirInterpreter.T T_COMP_0) () + | COMPUTE -> print_value (MenhirInterpreter.T T_COMPUTE) () + | COMPUTATIONAL_7 -> print_value (MenhirInterpreter.T T_COMPUTATIONAL_7) () + | COMPUTATIONAL_14 -> print_value (MenhirInterpreter.T T_COMPUTATIONAL_14) () + | COMPUTATIONAL_13 -> print_value (MenhirInterpreter.T T_COMPUTATIONAL_13) () + | COMPUTATIONAL_12 -> print_value (MenhirInterpreter.T T_COMPUTATIONAL_12) () + | COMPUTATIONAL_11 -> print_value (MenhirInterpreter.T T_COMPUTATIONAL_11) () + | COMPLEMENTARY -> print_value (MenhirInterpreter.T T_COMPLEMENTARY) () + | COMPLE -> print_value (MenhirInterpreter.T T_COMPLE) () + | COMP -> print_value (MenhirInterpreter.T T_COMP) () + | COMMUNICATION -> print_value (MenhirInterpreter.T T_COMMUNICATION) () + | COMMON -> print_value (MenhirInterpreter.T T_COMMON) () + | COMMIT -> print_value (MenhirInterpreter.T T_COMMIT) () + | COMMAND_LINE -> print_value (MenhirInterpreter.T T_COMMAND_LINE) () + | COMMA -> print_value (MenhirInterpreter.T T_COMMA) () + | COMBO_BOX -> print_value (MenhirInterpreter.T T_COMBO_BOX) () + | COLUMN_PROTECTION -> print_value (MenhirInterpreter.T T_COLUMN_PROTECTION) () + | COLUMN_HEADINGS -> print_value (MenhirInterpreter.T T_COLUMN_HEADINGS) () + | COLUMN_FONT -> print_value (MenhirInterpreter.T T_COLUMN_FONT) () + | COLUMN_DIVIDERS -> print_value (MenhirInterpreter.T T_COLUMN_DIVIDERS) () + | COLUMN_COLOR -> print_value (MenhirInterpreter.T T_COLUMN_COLOR) () + | COLUMNS -> print_value (MenhirInterpreter.T T_COLUMNS) () + | COLUMN -> print_value (MenhirInterpreter.T T_COLUMN) () + | COLORS -> print_value (MenhirInterpreter.T T_COLORS) () + | COLOR -> print_value (MenhirInterpreter.T T_COLOR) () + | COLON -> print_value (MenhirInterpreter.T T_COLON) () + | COLLATING -> print_value (MenhirInterpreter.T T_COLLATING) () + | COL -> print_value (MenhirInterpreter.T T_COL) () + | CODE_SET -> print_value (MenhirInterpreter.T T_CODE_SET) () + | CODE -> print_value (MenhirInterpreter.T T_CODE) () + | COBOL -> print_value (MenhirInterpreter.T T_COBOL) () + | CLOSE -> print_value (MenhirInterpreter.T T_CLOSE) () + | CLOCK_UNITS -> print_value (MenhirInterpreter.T T_CLOCK_UNITS) () + | CLINES -> print_value (MenhirInterpreter.T T_CLINES) () + | CLINE -> print_value (MenhirInterpreter.T T_CLINE) () + | CLEAR_SELECTION -> print_value (MenhirInterpreter.T T_CLEAR_SELECTION) () + | CLASS_ID -> print_value (MenhirInterpreter.T T_CLASS_ID) () + | CLASSIFICATION -> print_value (MenhirInterpreter.T T_CLASSIFICATION) () + | CLASS -> print_value (MenhirInterpreter.T T_CLASS) () + | CHECK_BOX -> print_value (MenhirInterpreter.T T_CHECK_BOX) () + | CHECKPOINT_FILE -> print_value (MenhirInterpreter.T T_CHECKPOINT_FILE) () + | CHECK -> print_value (MenhirInterpreter.T T_CHECK) () + | CHARACTERS -> print_value (MenhirInterpreter.T T_CHARACTERS) () + | CHARACTER -> print_value (MenhirInterpreter.T T_CHARACTER) () + | CHANGED -> print_value (MenhirInterpreter.T T_CHANGED) () + | CHAINING -> print_value (MenhirInterpreter.T T_CHAINING) () + | CHAIN -> print_value (MenhirInterpreter.T T_CHAIN) () + | CH -> print_value (MenhirInterpreter.T T_CH) () + | CF -> print_value (MenhirInterpreter.T T_CF) () + | CENTURY_DATE -> print_value (MenhirInterpreter.T T_CENTURY_DATE) () + | CENTERED_HEADINGS -> print_value (MenhirInterpreter.T T_CENTERED_HEADINGS) () + | CENTERED -> print_value (MenhirInterpreter.T T_CENTERED) () + | CENTER -> print_value (MenhirInterpreter.T T_CENTER) () + | CELL_PROTECTION -> print_value (MenhirInterpreter.T T_CELL_PROTECTION) () + | CELL_FONT -> print_value (MenhirInterpreter.T T_CELL_FONT) () + | CELL_DATA -> print_value (MenhirInterpreter.T T_CELL_DATA) () + | CELL_COLOR -> print_value (MenhirInterpreter.T T_CELL_COLOR) () + | CELL -> print_value (MenhirInterpreter.T T_CELL) () + | CD -> print_value (MenhirInterpreter.T T_CD) () + | CCOL -> print_value (MenhirInterpreter.T T_CCOL) () + | CATALOGUE_NAME -> print_value (MenhirInterpreter.T T_CATALOGUE_NAME) () + | CATALOGUED -> print_value (MenhirInterpreter.T T_CATALOGUED) () + | CASSETTE -> print_value (MenhirInterpreter.T T_CASSETTE) () + | CARD_READER -> print_value (MenhirInterpreter.T T_CARD_READER) () + | CARD_PUNCH -> print_value (MenhirInterpreter.T T_CARD_PUNCH) () + | CAPACITY -> print_value (MenhirInterpreter.T T_CAPACITY) () + | CANCEL_BUTTON -> print_value (MenhirInterpreter.T T_CANCEL_BUTTON) () + | CANCEL -> print_value (MenhirInterpreter.T T_CANCEL) () + | CALL -> print_value (MenhirInterpreter.T T_CALL) () + | CALENDAR_FONT -> print_value (MenhirInterpreter.T T_CALENDAR_FONT) () + | C -> print_value (MenhirInterpreter.T T_C) () + | B_XOR -> print_value (MenhirInterpreter.T T_B_XOR) () + | B_SHIFT_RC -> print_value (MenhirInterpreter.T T_B_SHIFT_RC) () + | B_SHIFT_R -> print_value (MenhirInterpreter.T T_B_SHIFT_R) () + | B_SHIFT_LC -> print_value (MenhirInterpreter.T T_B_SHIFT_LC) () + | B_SHIFT_L -> print_value (MenhirInterpreter.T T_B_SHIFT_L) () + | B_OR -> print_value (MenhirInterpreter.T T_B_OR) () + | B_NOT -> print_value (MenhirInterpreter.T T_B_NOT) () + | B_EXOR -> print_value (MenhirInterpreter.T T_B_EXOR) () + | B_AND -> print_value (MenhirInterpreter.T T_B_AND) () + | BYTE_LENGTH -> print_value (MenhirInterpreter.T T_BYTE_LENGTH) () + | BYTES -> print_value (MenhirInterpreter.T T_BYTES) () + | BYTE -> print_value (MenhirInterpreter.T T_BYTE) () + | BY -> print_value (MenhirInterpreter.T T_BY) () + | BUTTONS -> print_value (MenhirInterpreter.T T_BUTTONS) () + | BUSY -> print_value (MenhirInterpreter.T T_BUSY) () + | BULK_ADDITION -> print_value (MenhirInterpreter.T T_BULK_ADDITION) () + | BSN -> print_value (MenhirInterpreter.T T_BSN) () + | BOXED -> print_value (MenhirInterpreter.T T_BOXED) () + | BOX -> print_value (MenhirInterpreter.T T_BOX) () + | BOTTOM -> print_value (MenhirInterpreter.T T_BOTTOM) () + | BOOLIT v -> print_value (MenhirInterpreter.T T_BOOLIT) v + | BOOLEAN -> print_value (MenhirInterpreter.T T_BOOLEAN) () + | BLOCK -> print_value (MenhirInterpreter.T T_BLOCK) () + | BLINK -> print_value (MenhirInterpreter.T T_BLINK) () + | BLANK -> print_value (MenhirInterpreter.T T_BLANK) () + | BITS -> print_value (MenhirInterpreter.T T_BITS) () + | BITMAP_WIDTH -> print_value (MenhirInterpreter.T T_BITMAP_WIDTH) () + | BITMAP_TRANSPARENT_COLOR -> print_value (MenhirInterpreter.T T_BITMAP_TRANSPARENT_COLOR) () + | BITMAP_TRAILING -> print_value (MenhirInterpreter.T T_BITMAP_TRAILING) () + | BITMAP_TIMER -> print_value (MenhirInterpreter.T T_BITMAP_TIMER) () + | BITMAP_START -> print_value (MenhirInterpreter.T T_BITMAP_START) () + | BITMAP_NUMBER -> print_value (MenhirInterpreter.T T_BITMAP_NUMBER) () + | BITMAP_HANDLE -> print_value (MenhirInterpreter.T T_BITMAP_HANDLE) () + | BITMAP_END -> print_value (MenhirInterpreter.T T_BITMAP_END) () + | BITMAP -> print_value (MenhirInterpreter.T T_BITMAP) () + | BIT -> print_value (MenhirInterpreter.T T_BIT) () + | BINARY_SHORT -> print_value (MenhirInterpreter.T T_BINARY_SHORT) () + | BINARY_SEQUENTIAL -> print_value (MenhirInterpreter.T T_BINARY_SEQUENTIAL) () + | BINARY_LONG -> print_value (MenhirInterpreter.T T_BINARY_LONG) () + | BINARY_ENCODING -> print_value (MenhirInterpreter.T T_BINARY_ENCODING) () + | BINARY_DOUBLE -> print_value (MenhirInterpreter.T T_BINARY_DOUBLE) () + | BINARY_C_LONG -> print_value (MenhirInterpreter.T T_BINARY_C_LONG) () + | BINARY_CHAR -> print_value (MenhirInterpreter.T T_BINARY_CHAR) () + | BINARY -> print_value (MenhirInterpreter.T T_BINARY) () + | BELL -> print_value (MenhirInterpreter.T T_BELL) () + | BEGINNING -> print_value (MenhirInterpreter.T T_BEGINNING) () + | BEFORE -> print_value (MenhirInterpreter.T T_BEFORE) () + | BECOMES -> print_value (MenhirInterpreter.T T_BECOMES) () + | BASED -> print_value (MenhirInterpreter.T T_BASED) () + | BAR -> print_value (MenhirInterpreter.T T_BAR) () + | BACKWARD -> print_value (MenhirInterpreter.T T_BACKWARD) () + | BACKGROUND_STANDARD -> print_value (MenhirInterpreter.T T_BACKGROUND_STANDARD) () + | BACKGROUND_LOW -> print_value (MenhirInterpreter.T T_BACKGROUND_LOW) () + | BACKGROUND_HIGH -> print_value (MenhirInterpreter.T T_BACKGROUND_HIGH) () + | BACKGROUND_COLOR -> print_value (MenhirInterpreter.T T_BACKGROUND_COLOR) () + | AWAY_FROM_ZERO -> print_value (MenhirInterpreter.T T_AWAY_FROM_ZERO) () + | AUTO_SPIN -> print_value (MenhirInterpreter.T T_AUTO_SPIN) () + | AUTO_DECIMAL -> print_value (MenhirInterpreter.T T_AUTO_DECIMAL) () + | AUTOMATIC -> print_value (MenhirInterpreter.T T_AUTOMATIC) () + | AUTO -> print_value (MenhirInterpreter.T T_AUTO) () + | AUTHOR v -> print_value (MenhirInterpreter.T T_AUTHOR) v + | AT_EOP -> print_value (MenhirInterpreter.T T_AT_EOP) () + | AT_END -> print_value (MenhirInterpreter.T T_AT_END) () + | ATTRIBUTES -> print_value (MenhirInterpreter.T T_ATTRIBUTES) () + | ATTRIBUTE -> print_value (MenhirInterpreter.T T_ATTRIBUTE) () + | AT -> print_value (MenhirInterpreter.T T_AT) () + | ASTERISK -> print_value (MenhirInterpreter.T T_ASTERISK) () + | ASSIGN -> print_value (MenhirInterpreter.T T_ASSIGN) () + | ASCII -> print_value (MenhirInterpreter.T T_ASCII) () + | ASCENDING -> print_value (MenhirInterpreter.T T_ASCENDING) () + | ASA -> print_value (MenhirInterpreter.T T_ASA) () + | AS -> print_value (MenhirInterpreter.T T_AS) () + | ARITHMETIC -> print_value (MenhirInterpreter.T T_ARITHMETIC) () + | ARGUMENT_VALUE -> print_value (MenhirInterpreter.T T_ARGUMENT_VALUE) () + | ARGUMENT_NUMBER -> print_value (MenhirInterpreter.T T_ARGUMENT_NUMBER) () + | AREAS -> print_value (MenhirInterpreter.T T_AREAS) () + | AREA -> print_value (MenhirInterpreter.T T_AREA) () + | ARE -> print_value (MenhirInterpreter.T T_ARE) () + | APPLY -> print_value (MenhirInterpreter.T T_APPLY) () + | ANYCASE -> print_value (MenhirInterpreter.T T_ANYCASE) () + | ANY -> print_value (MenhirInterpreter.T T_ANY) () + | ANUM -> print_value (MenhirInterpreter.T T_ANUM) () + | ANSI -> print_value (MenhirInterpreter.T T_ANSI) () + | AND -> print_value (MenhirInterpreter.T T_AND) () + | AMPERSAND -> print_value (MenhirInterpreter.T T_AMPERSAND) () + | ALTERNATE -> print_value (MenhirInterpreter.T T_ALTERNATE) () + | ALTERING -> print_value (MenhirInterpreter.T T_ALTERING) () + | ALTER -> print_value (MenhirInterpreter.T T_ALTER) () + | ALSO -> print_value (MenhirInterpreter.T T_ALSO) () + | ALPHANUM_PREFIX v -> print_value (MenhirInterpreter.T T_ALPHANUM_PREFIX) v + | ALPHANUMERIC_EDITED -> print_value (MenhirInterpreter.T T_ALPHANUMERIC_EDITED) () + | ALPHANUMERIC -> print_value (MenhirInterpreter.T T_ALPHANUMERIC) () + | ALPHANUM v -> print_value (MenhirInterpreter.T T_ALPHANUM) v + | ALPHABETIC_UPPER -> print_value (MenhirInterpreter.T T_ALPHABETIC_UPPER) () + | ALPHABETIC_LOWER -> print_value (MenhirInterpreter.T T_ALPHABETIC_LOWER) () + | ALPHABETIC -> print_value (MenhirInterpreter.T T_ALPHABETIC) () + | ALPHABET -> print_value (MenhirInterpreter.T T_ALPHABET) () + | ALLOWING -> print_value (MenhirInterpreter.T T_ALLOWING) () + | ALLOCATE -> print_value (MenhirInterpreter.T T_ALLOCATE) () + | ALL -> print_value (MenhirInterpreter.T T_ALL) () + | ALIGNMENT -> print_value (MenhirInterpreter.T T_ALIGNMENT) () + | ALIGNED -> print_value (MenhirInterpreter.T T_ALIGNED) () + | ALIAS -> print_value (MenhirInterpreter.T T_ALIAS) () + | AFTER -> print_value (MenhirInterpreter.T T_AFTER) () + | ADVANCING -> print_value (MenhirInterpreter.T T_ADVANCING) () + | ADJUSTABLE_COLUMNS -> print_value (MenhirInterpreter.T T_ADJUSTABLE_COLUMNS) () + | ADDRESS -> print_value (MenhirInterpreter.T T_ADDRESS) () + | ADD -> print_value (MenhirInterpreter.T T_ADD) () + | ACTUAL -> print_value (MenhirInterpreter.T T_ACTUAL) () + | ACTIVE_X -> print_value (MenhirInterpreter.T T_ACTIVE_X) () + | ACTIVE_CLASS -> print_value (MenhirInterpreter.T T_ACTIVE_CLASS) () + | ACTIVATING -> print_value (MenhirInterpreter.T T_ACTIVATING) () + | ACTION -> print_value (MenhirInterpreter.T T_ACTION) () + | ACCESS -> print_value (MenhirInterpreter.T T_ACCESS) () + | ACCEPT -> print_value (MenhirInterpreter.T T_ACCEPT) () + | ABSENT -> print_value (MenhirInterpreter.T T_ABSENT) () + +let token_of_terminal (type a) (t : a MenhirInterpreter.terminal) (v : a) : token = + match t with + | T_error -> assert false + | T_ZERO_FILL -> ZERO_FILL + | T_ZERO -> ZERO + | T_YYYYMMDD -> YYYYMMDD + | T_YYYYDDD -> YYYYDDD + | T_Y -> Y + | T_XOR -> XOR + | T_XML_SCHEMA -> XML_SCHEMA + | T_XML_DECLARATION -> XML_DECLARATION + | T_XML -> XML + | T_X -> X + | T_WRITE_VERIFY -> WRITE_VERIFY + | T_WRITE_ONLY -> WRITE_ONLY + | T_WRITERS -> WRITERS + | T_WRITE -> WRITE + | T_WRAP -> WRAP + | T_WORKING_STORAGE -> WORKING_STORAGE + | T_WORD_IN_AREA_A -> WORD_IN_AREA_A v + | T_WORDS -> WORDS + | T_WORD -> WORD v + | T_WITH_DATA -> WITH_DATA + | T_WITH -> WITH + | T_WINDOW -> WINDOW + | T_WIDTH_IN_CELLS -> WIDTH_IN_CELLS + | T_WIDTH -> WIDTH + | T_WHEN -> WHEN + | T_WEB_BROWSER -> WEB_BROWSER + | T_WAIT -> WAIT + | T_VTOP -> VTOP + | T_VSCROLL_POS -> VSCROLL_POS + | T_VSCROLL_BAR -> VSCROLL_BAR + | T_VSCROLL -> VSCROLL + | T_VPADDING -> VPADDING + | T_VOLATILE -> VOLATILE + | T_VLR -> VLR + | T_VIRTUAL_WIDTH -> VIRTUAL_WIDTH + | T_VIRTUAL -> VIRTUAL + | T_VIA -> VIA + | T_VERY_HEAVY -> VERY_HEAVY + | T_VERTICAL -> VERTICAL + | T_VARYING -> VARYING + | T_VARIANT -> VARIANT + | T_VARIABLE -> VARIABLE + | T_VALUE_FORMAT -> VALUE_FORMAT + | T_VALUES -> VALUES + | T_VALUE -> VALUE + | T_VALIDATING -> VALIDATING + | T_VALIDATE_STATUS -> VALIDATE_STATUS + | T_VALIDATE -> VALIDATE + | T_VALID -> VALID + | T_V -> V + | T_UTF_8 -> UTF_8 + | T_UTF_16 -> UTF_16 + | T_USING -> USING + | T_USE_TAB -> USE_TAB + | T_USE_RETURN -> USE_RETURN + | T_USE_ALT -> USE_ALT + | T_USER_DEFAULT -> USER_DEFAULT + | T_USER -> USER + | T_USE -> USE + | T_USAGE -> USAGE + | T_UPPER -> UPPER + | T_UPON -> UPON + | T_UPDATERS -> UPDATERS + | T_UPDATE -> UPDATE + | T_UP -> UP + | T_UNUSED__ -> UNUSED__ + | T_UNTIL -> UNTIL + | T_UNSTRING -> UNSTRING + | T_UNSORTED -> UNSORTED + | T_UNSIGNED_SHORT -> UNSIGNED_SHORT + | T_UNSIGNED_LONG -> UNSIGNED_LONG + | T_UNSIGNED_INT -> UNSIGNED_INT + | T_UNSIGNED -> UNSIGNED + | T_UNSEQUAL -> UNSEQUAL + | T_UNLOCK -> UNLOCK + | T_UNIVERSAL -> UNIVERSAL + | T_UNIT -> UNIT + | T_UNFRAMED -> UNFRAMED + | T_UNDERLINE -> UNDERLINE + | T_UNBOUNDED -> UNBOUNDED + | T_UFF -> UFF + | T_UCS_4 -> UCS_4 + | T_U -> U + | T_TYPEDEF -> TYPEDEF + | T_TYPE -> TYPE + | T_TRUNCATION -> TRUNCATION + | T_TRUE -> TRUE + | T_TREE_VIEW -> TREE_VIEW + | T_TRANSPARENT -> TRANSPARENT + | T_TRANSFORM -> TRANSFORM + | T_TRAILING_SIGN -> TRAILING_SIGN + | T_TRAILING_SHIFT -> TRAILING_SHIFT + | T_TRAILING -> TRAILING + | T_TRADITIONAL_FONT -> TRADITIONAL_FONT + | T_TRACK_LIMIT -> TRACK_LIMIT + | T_TRACK_AREA -> TRACK_AREA + | T_TRACKS -> TRACKS + | T_TRACK -> TRACK + | T_TOWARD_LESSER -> TOWARD_LESSER + | T_TOWARD_GREATER -> TOWARD_GREATER + | T_TOP_LEVEL -> TOP_LEVEL + | T_TOP -> TOP + | T_TO -> TO + | T_TITLE_POSITION -> TITLE_POSITION + | T_TITLE -> TITLE + | T_TIME_OUT -> TIME_OUT + | T_TIMES -> TIMES + | T_TIME -> TIME + | T_TILED_HEADINGS -> TILED_HEADINGS + | T_THUMB_POSITION -> THUMB_POSITION + | T_THROUGH -> THROUGH + | T_THREEDIMENSIONAL -> THREEDIMENSIONAL + | T_THREADS -> THREADS + | T_THREAD -> THREAD + | T_THEN -> THEN + | T_THAN -> THAN + | T_TEXT -> TEXT + | T_TEST -> TEST + | T_TERMINATION_VALUE -> TERMINATION_VALUE + | T_TERMINATE -> TERMINATE + | T_TERMINAL_X -> TERMINAL_X + | T_TERMINAL_INFO -> TERMINAL_INFO + | T_TERMINAL_3 -> TERMINAL_3 + | T_TERMINAL_2 -> TERMINAL_2 + | T_TERMINAL_1 -> TERMINAL_1 + | T_TERMINAL_0 -> TERMINAL_0 + | T_TERMINAL -> TERMINAL + | T_TEMPORARY -> TEMPORARY + | T_TEMP -> TEMP + | T_TAPE -> TAPE + | T_TALLYING -> TALLYING + | T_TAB_TO_DELETE -> TAB_TO_DELETE + | T_TAB_TO_ADD -> TAB_TO_ADD + | T_TABLE -> TABLE + | T_TAB -> TAB + | T_SYSTEM_OFFSET -> SYSTEM_OFFSET + | T_SYSTEM_INFO -> SYSTEM_INFO + | T_SYSTEM_DEFAULT -> SYSTEM_DEFAULT + | T_SYSTEM -> SYSTEM + | T_SYSOUT_X -> SYSOUT_X + | T_SYSOUT_3 -> SYSOUT_3 + | T_SYSOUT_2 -> SYSOUT_2 + | T_SYSOUT_1 -> SYSOUT_1 + | T_SYSOUT_0 -> SYSOUT_0 + | T_SYSIN_X -> SYSIN_X + | T_SYSIN_3 -> SYSIN_3 + | T_SYSIN_2 -> SYSIN_2 + | T_SYSIN_1 -> SYSIN_1 + | T_SYSIN_0 -> SYSIN_0 + | T_SYNCHRONIZED -> SYNCHRONIZED + | T_SYMBOLIC -> SYMBOLIC + | T_SYMBOL -> SYMBOL + | T_SWITCH -> SWITCH + | T_SUPPRESS -> SUPPRESS + | T_SUPER -> SUPER + | T_SUM -> SUM + | T_SUB_SCHEMA -> SUB_SCHEMA + | T_SUB_QUEUE_3 -> SUB_QUEUE_3 + | T_SUB_QUEUE_2 -> SUB_QUEUE_2 + | T_SUB_QUEUE_1 -> SUB_QUEUE_1 + | T_SUBWINDOW -> SUBWINDOW + | T_SUBTRACT -> SUBTRACT + | T_STYLE -> STYLE + | T_STRUCTURE -> STRUCTURE + | T_STRONG -> STRONG + | T_STRING -> STRING + | T_STOP -> STOP + | T_STEP -> STEP + | T_STDCALL -> STDCALL + | T_STATUS_TEXT -> STATUS_TEXT + | T_STATUS_BAR -> STATUS_BAR + | T_STATUS -> STATUS + | T_STATION -> STATION + | T_STATIC_LIST -> STATIC_LIST + | T_STATIC -> STATIC + | T_STATEMENT -> STATEMENT + | T_START_Y -> START_Y + | T_START_X -> START_X + | T_START -> START + | T_STANDARD_DECIMAL -> STANDARD_DECIMAL + | T_STANDARD_BINARY -> STANDARD_BINARY + | T_STANDARD_2 -> STANDARD_2 + | T_STANDARD_1 -> STANDARD_1 + | T_STANDARD -> STANDARD + | T_STACK -> STACK + | T_SSF -> SSF + | T_SQUARE -> SQUARE + | T_SPINNER -> SPINNER + | T_SPECIAL_NAMES -> SPECIAL_NAMES + | T_SPACE_FILL -> SPACE_FILL + | T_SPACE -> SPACE + | T_SOURCE_COMPUTER -> SOURCE_COMPUTER + | T_SOURCES -> SOURCES + | T_SOURCE -> SOURCE + | T_SORT_ORDER -> SORT_ORDER + | T_SORT_MERGE -> SORT_MERGE + | T_SORT -> SORT + | T_SMALL_FONT -> SMALL_FONT + | T_SLASH -> SLASH + | T_SIZE -> SIZE + | T_SINTLIT -> SINTLIT v + | T_SIGNED_SHORT -> SIGNED_SHORT + | T_SIGNED_LONG -> SIGNED_LONG + | T_SIGNED_INT -> SIGNED_INT + | T_SIGNED -> SIGNED + | T_SIGN -> SIGN + | T_SHOW_SEL_ALWAYS -> SHOW_SEL_ALWAYS + | T_SHOW_NONE -> SHOW_NONE + | T_SHOW_LINES -> SHOW_LINES + | T_SHORT_DATE -> SHORT_DATE + | T_SHORT -> SHORT + | T_SHARING -> SHARING + | T_SHADOW -> SHADOW + | T_SHADING -> SHADING + | T_SET -> SET + | T_SEQUENTIAL -> SEQUENTIAL + | T_SEQUENCE -> SEQUENCE + | T_SEPARATION -> SEPARATION + | T_SEPARATE -> SEPARATE + | T_SENTENCE -> SENTENCE + | T_SEND -> SEND + | T_SELF_ACT -> SELF_ACT + | T_SELF -> SELF + | T_SELECT_ALL -> SELECT_ALL + | T_SELECTION_TEXT -> SELECTION_TEXT + | T_SELECTION_INDEX -> SELECTION_INDEX + | T_SELECTION -> SELECTION + | T_SELECT -> SELECT + | T_SEGMENT_LIMIT -> SEGMENT_LIMIT + | T_SEGMENT -> SEGMENT + | T_SECURITY -> SECURITY v + | T_SECURE -> SECURE + | T_SECTION -> SECTION + | T_SECONDS -> SECONDS + | T_SECONDARY -> SECONDARY + | T_SEARCH_TEXT -> SEARCH_TEXT + | T_SEARCH_OPTIONS -> SEARCH_OPTIONS + | T_SEARCH -> SEARCH + | T_SD -> SD + | T_SCROLL_BAR -> SCROLL_BAR + | T_SCROLL -> SCROLL + | T_SCREEN -> SCREEN + | T_SAVE_AS_NO_PROMPT -> SAVE_AS_NO_PROMPT + | T_SAVE_AS -> SAVE_AS + | T_SARF -> SARF + | T_SAME -> SAME + | T_S -> S + | T_RUN -> RUN + | T_RPAR -> RPAR + | T_ROW_PROTECTION -> ROW_PROTECTION + | T_ROW_HEADINGS -> ROW_HEADINGS + | T_ROW_FONT -> ROW_FONT + | T_ROW_DIVIDERS -> ROW_DIVIDERS + | T_ROW_COLOR_PATTERN -> ROW_COLOR_PATTERN + | T_ROW_COLOR -> ROW_COLOR + | T_ROUNDING -> ROUNDING + | T_ROUNDED -> ROUNDED + | T_ROLLBACK -> ROLLBACK + | T_RIMMED -> RIMMED + | T_RIGHT_JUSTIFY -> RIGHT_JUSTIFY + | T_RIGHT_ALIGN -> RIGHT_ALIGN + | T_RIGHT -> RIGHT + | T_RH -> RH + | T_RF -> RF + | T_REWRITE -> REWRITE + | T_REWIND -> REWIND + | T_REVERSE_VIDEO -> REVERSE_VIDEO + | T_REVERSED -> REVERSED + | T_REVERSE -> REVERSE + | T_RETURNING -> RETURNING + | T_RETURN -> RETURN + | T_RETRY -> RETRY + | T_RETENTION -> RETENTION + | T_RESUME -> RESUME + | T_RESET_TABS -> RESET_TABS + | T_RESET_LIST -> RESET_LIST + | T_RESET_GRID -> RESET_GRID + | T_RESET -> RESET + | T_RESERVE -> RESERVE + | T_RERUN -> RERUN + | T_REREAD -> REREAD + | T_REQUIRED -> REQUIRED + | T_REPOSITORY -> REPOSITORY + | T_REPORTS -> REPORTS + | T_REPORTING -> REPORTING + | T_REPORT -> REPORT + | T_REPLACING -> REPLACING + | T_REPLACE -> REPLACE + | T_REPEATED -> REPEATED + | T_REORG_CRITERIA -> REORG_CRITERIA + | T_RENAMES -> RENAMES + | T_REMOVAL -> REMOVAL + | T_REMARKS -> REMARKS v + | T_REMAINDER -> REMAINDER + | T_RELEASE -> RELEASE + | T_RELATIVE -> RELATIVE + | T_RELATION -> RELATION + | T_REGION_COLOR -> REGION_COLOR + | T_REFRESH -> REFRESH + | T_REFERENCES -> REFERENCES + | T_REFERENCE -> REFERENCE + | T_REEL -> REEL + | T_REDEFINES -> REDEFINES + | T_RECURSIVE -> RECURSIVE + | T_RECORD_TO_DELETE -> RECORD_TO_DELETE + | T_RECORD_TO_ADD -> RECORD_TO_ADD + | T_RECORD_OVERFLOW -> RECORD_OVERFLOW + | T_RECORD_DATA -> RECORD_DATA + | T_RECORDS -> RECORDS + | T_RECORDING -> RECORDING + | T_RECORD -> RECORD + | T_RECEIVED -> RECEIVED + | T_RECEIVE -> RECEIVE + | T_READ_ONLY -> READ_ONLY + | T_READERS -> READERS + | T_READ -> READ + | T_RD -> RD + | T_RANDOM -> RANDOM + | T_RAISING -> RAISING + | T_RAISED -> RAISED + | T_RAISE -> RAISE + | T_RADIO_BUTTON -> RADIO_BUTTON + | T_QUOTE -> QUOTE + | T_QUEUED -> QUEUED + | T_QUEUE -> QUEUE + | T_QUERY_INDEX -> QUERY_INDEX + | T_PUSH_BUTTON -> PUSH_BUTTON + | T_PURGE -> PURGE + | T_PROTOTYPE -> PROTOTYPE + | T_PROTECTED -> PROTECTED + | T_PROPERTY -> PROPERTY + | T_PROPERTIES -> PROPERTIES + | T_PROMPT -> PROMPT + | T_PROHIBITED -> PROHIBITED + | T_PROGRESS -> PROGRESS + | T_PROGRAM_POINTER -> PROGRAM_POINTER + | T_PROGRAM_ID -> PROGRAM_ID + | T_PROGRAM -> PROGRAM + | T_PROCESS_AREA -> PROCESS_AREA + | T_PROCESSING -> PROCESSING + | T_PROCEED -> PROCEED + | T_PROCEDURE_POINTER -> PROCEDURE_POINTER + | T_PROCEDURES -> PROCEDURES + | T_PROCEDURE -> PROCEDURE + | T_PRIORITY -> PRIORITY + | T_PRINT_PREVIEW -> PRINT_PREVIEW + | T_PRINT_NO_PROMPT -> PRINT_NO_PROMPT + | T_PRINTING -> PRINTING + | T_PRINTER_1 -> PRINTER_1 + | T_PRINTER -> PRINTER + | T_PRINT -> PRINT + | T_PRIMARY -> PRIMARY + | T_PREVIOUS -> PREVIOUS + | T_PRESENT -> PRESENT + | T_PREFIXED -> PREFIXED + | T_POSITIVE -> POSITIVE + | T_POSITION_SHIFT -> POSITION_SHIFT + | T_POSITION -> POSITION + | T_POS -> POS + | T_POP_UP -> POP_UP + | T_POINTER -> POINTER + | T_PLUS_SIGN -> PLUS_SIGN + | T_PLUS -> PLUS + | T_PLACEMENT -> PLACEMENT + | T_PIXEL -> PIXEL + | T_PICTURE_STRING -> PICTURE_STRING v + | T_PICTURE -> PICTURE + | T_PHYSICAL -> PHYSICAL + | T_PH -> PH + | T_PF -> PF + | T_PERMANENT -> PERMANENT + | T_PERIOD -> PERIOD + | T_PERFORM -> PERFORM + | T_PASSWORD -> PASSWORD + | T_PASCAL -> PASCAL + | T_PARSE -> PARSE + | T_PARENT -> PARENT + | T_PARAGRAPH -> PARAGRAPH + | T_PAGE_SETUP -> PAGE_SETUP + | T_PAGE_COUNTER -> PAGE_COUNTER + | T_PAGED -> PAGED + | T_PAGE -> PAGE + | T_PADDING -> PADDING + | T_PACKED_DECIMAL -> PACKED_DECIMAL + | T_OVERRIDING -> OVERRIDING + | T_OVERRIDE -> OVERRIDE + | T_OVERLINE -> OVERLINE + | T_OVERLAP_TOP -> OVERLAP_TOP + | T_OVERLAP_LEFT -> OVERLAP_LEFT + | T_OVERFLOW -> OVERFLOW + | T_OUTPUT -> OUTPUT + | T_OTHERS -> OTHERS + | T_OTHER -> OTHER + | T_ORGANIZATION -> ORGANIZATION + | T_ORDER -> ORDER + | T_OR -> OR + | T_OPTIONS -> OPTIONS + | T_OPTIONAL -> OPTIONAL + | T_OPERATIONAL -> OPERATIONAL + | T_OPEN -> OPEN + | T_ON_SIZE_ERROR -> ON_SIZE_ERROR + | T_ON_OVERFLOW -> ON_OVERFLOW + | T_ON_EXCEPTION -> ON_EXCEPTION + | T_ONLY -> ONLY + | T_ON -> ON + | T_OMITTED -> OMITTED + | T_OK_BUTTON -> OK_BUTTON + | T_OFF -> OFF + | T_OF -> OF + | T_OCCURS -> OCCURS + | T_OBJECT_REFERENCE -> OBJECT_REFERENCE + | T_OBJECT_PROGRAM -> OBJECT_PROGRAM + | T_OBJECT_COMPUTER -> OBJECT_COMPUTER + | T_OBJECT -> OBJECT + | T_NUM_ROWS -> NUM_ROWS + | T_NUM_COL_HEADINGS -> NUM_COL_HEADINGS + | T_NUMERIC_EDITED -> NUMERIC_EDITED + | T_NUMERIC -> NUMERIC + | T_NUMBERS -> NUMBERS + | T_NUMBER -> NUMBER + | T_NULLS -> NULLS + | T_NULLIT -> NULLIT v + | T_NULL -> NULL + | T_NO_UPDOWN -> NO_UPDOWN + | T_NO_SEARCH -> NO_SEARCH + | T_NO_KEY_LETTER -> NO_KEY_LETTER + | T_NO_GROUP_TAB -> NO_GROUP_TAB + | T_NO_FOCUS -> NO_FOCUS + | T_NO_F4 -> NO_F4 + | T_NO_ECHO -> NO_ECHO + | T_NO_DIVIDERS -> NO_DIVIDERS + | T_NO_DATA -> NO_DATA + | T_NO_BOX -> NO_BOX + | T_NO_AUTO_DEFAULT -> NO_AUTO_DEFAULT + | T_NO_AUTOSEL -> NO_AUTOSEL + | T_NOT_ON_SIZE_ERROR -> NOT_ON_SIZE_ERROR + | T_NOT_ON_OVERFLOW -> NOT_ON_OVERFLOW + | T_NOT_ON_EXCEPTION -> NOT_ON_EXCEPTION + | T_NOT_INVALID_KEY -> NOT_INVALID_KEY + | T_NOT_AT_EOP -> NOT_AT_EOP + | T_NOT_AT_END -> NOT_AT_END + | T_NOTIFY_SELCHANGE -> NOTIFY_SELCHANGE + | T_NOTIFY_DBLCLICK -> NOTIFY_DBLCLICK + | T_NOTIFY_CHANGE -> NOTIFY_CHANGE + | T_NOTIFY -> NOTIFY + | T_NOTHING -> NOTHING + | T_NOTAB -> NOTAB + | T_NOT -> NOT + | T_NORMAL -> NORMAL + | T_NONNUMERIC -> NONNUMERIC + | T_NONE -> NONE + | T_NOMINAL -> NOMINAL + | T_NO -> NO + | T_NEXT_PAGE -> NEXT_PAGE + | T_NEXT_ITEM -> NEXT_ITEM + | T_NEXT -> NEXT + | T_NEW -> NEW + | T_NESTED -> NESTED + | T_NEGATIVE -> NEGATIVE + | T_NEAREST_TO_ZERO -> NEAREST_TO_ZERO + | T_NEAREST_TOWARD_ZERO -> NEAREST_TOWARD_ZERO + | T_NEAREST_EVEN -> NEAREST_EVEN + | T_NEAREST_AWAY_FROM_ZERO -> NEAREST_AWAY_FROM_ZERO + | T_NE -> NE + | T_NAVIGATE_URL -> NAVIGATE_URL + | T_NATLIT -> NATLIT v + | T_NATIVE -> NATIVE + | T_NATIONAL_EDITED -> NATIONAL_EDITED + | T_NATIONAL -> NATIONAL + | T_NAT -> NAT + | T_NAMESPACE_PREFIX -> NAMESPACE_PREFIX + | T_NAMESPACE -> NAMESPACE + | T_NAMED -> NAMED + | T_NAME -> NAME + | T_MULTIPLY -> MULTIPLY + | T_MULTIPLE -> MULTIPLE + | T_MULTILINE -> MULTILINE + | T_MOVE -> MOVE + | T_MODULES -> MODULES + | T_MODIFY -> MODIFY + | T_MODE -> MODE + | T_MIN_VAL -> MIN_VAL + | T_MINUS -> MINUS + | T_MICROSECOND_TIME -> MICROSECOND_TIME + | T_METHOD_ID -> METHOD_ID + | T_METHOD -> METHOD + | T_MESSAGE_TAG -> MESSAGE_TAG + | T_MESSAGE -> MESSAGE + | T_MERGE -> MERGE + | T_MENU -> MENU + | T_MEMORY -> MEMORY + | T_MEDIUM_FONT -> MEDIUM_FONT + | T_MAX_VAL -> MAX_VAL + | T_MAX_TEXT -> MAX_TEXT + | T_MAX_PROGRESS -> MAX_PROGRESS + | T_MAX_LINES -> MAX_LINES + | T_MASTER_INDEX -> MASTER_INDEX + | T_MASS_UPDATE -> MASS_UPDATE + | T_MANUAL -> MANUAL + | T_MAGNETIC_TAPE -> MAGNETIC_TAPE + | T_LT -> LT + | T_LPAR -> LPAR + | T_LOW_VALUE -> LOW_VALUE + | T_LOW_COLOR -> LOW_COLOR + | T_LOWLIGHT -> LOWLIGHT + | T_LOWERED -> LOWERED + | T_LOWER -> LOWER + | T_LONG_DATE -> LONG_DATE + | T_LOCK_HOLDING -> LOCK_HOLDING + | T_LOCKS -> LOCKS + | T_LOCK -> LOCK + | T_LOCATION -> LOCATION + | T_LOCAL_STORAGE -> LOCAL_STORAGE + | T_LOCALE -> LOCALE + | T_LOC -> LOC + | T_LM_RESIZE -> LM_RESIZE + | T_LIST_BOX -> LIST_BOX + | T_LINKAGE -> LINKAGE + | T_LINE_SEQUENTIAL -> LINE_SEQUENTIAL + | T_LINE_COUNTER -> LINE_COUNTER + | T_LINES_PER_PAGE -> LINES_PER_PAGE + | T_LINES_AT_ROOT -> LINES_AT_ROOT + | T_LINES -> LINES + | T_LINE -> LINE + | T_LINAGE_COUNTER -> LINAGE_COUNTER + | T_LINAGE -> LINAGE + | T_LIMITS -> LIMITS + | T_LIMIT -> LIMIT + | T_LIKE -> LIKE + | T_LIBRARY -> LIBRARY + | T_LESS -> LESS + | T_LENGTH -> LENGTH + | T_LEFT_TEXT -> LEFT_TEXT + | T_LEFT_JUSTIFY -> LEFT_JUSTIFY + | T_LEFTLINE -> LEFTLINE + | T_LEFT -> LEFT + | T_LEAVE -> LEAVE + | T_LEADING_SHIFT -> LEADING_SHIFT + | T_LEADING -> LEADING + | T_LE -> LE + | T_LC_TIME -> LC_TIME + | T_LC_NUMERIC -> LC_NUMERIC + | T_LC_MONETARY -> LC_MONETARY + | T_LC_MESSAGES -> LC_MESSAGES + | T_LC_CTYPE -> LC_CTYPE + | T_LC_COLLATE -> LC_COLLATE + | T_LC_ALL -> LC_ALL + | T_LAYOUT_MANAGER -> LAYOUT_MANAGER + | T_LAYOUT_DATA -> LAYOUT_DATA + | T_LAST_ROW -> LAST_ROW + | T_LAST -> LAST + | T_LARGE_OFFSET -> LARGE_OFFSET + | T_LARGE_FONT -> LARGE_FONT + | T_LABEL_OFFSET -> LABEL_OFFSET + | T_LABEL -> LABEL + | T_KEY_LOCATION -> KEY_LOCATION + | T_KEYED -> KEYED + | T_KEYBOARD -> KEYBOARD + | T_KEY -> KEY + | T_KEPT -> KEPT + | T_JUSTIFIED -> JUSTIFIED + | T_JSON -> JSON + | T_I_O_CONTROL -> I_O_CONTROL + | T_I_O -> I_O + | T_ITEM_VALUE -> ITEM_VALUE + | T_ITEM_TO_EMPTY -> ITEM_TO_EMPTY + | T_ITEM_TO_DELETE -> ITEM_TO_DELETE + | T_ITEM_TO_ADD -> ITEM_TO_ADD + | T_ITEM_TEXT -> ITEM_TEXT + | T_ITEM -> ITEM + | T_IS_TYPEDEF -> IS_TYPEDEF + | T_IS_GLOBAL -> IS_GLOBAL + | T_IS_EXTERNAL -> IS_EXTERNAL + | T_IS -> IS + | T_IN_ARITHMETIC_RANGE -> IN_ARITHMETIC_RANGE + | T_INVOKING -> INVOKING + | T_INVOKE -> INVOKE + | T_INVALID_KEY -> INVALID_KEY + | T_INVALID -> INVALID + | T_INTRINSIC -> INTRINSIC + | T_INTO -> INTO + | T_INTERVENING_ -> INTERVENING_ v + | T_INTERMEDIATE -> INTERMEDIATE + | T_INTERFACE_ID -> INTERFACE_ID + | T_INTERFACE -> INTERFACE + | T_INSTALLATION -> INSTALLATION v + | T_INSPECT -> INSPECT + | T_INSERT_ROWS -> INSERT_ROWS + | T_INSERTION_INDEX -> INSERTION_INDEX + | T_INQUIRE -> INQUIRE + | T_INPUT_OUTPUT -> INPUT_OUTPUT + | T_INPUT -> INPUT + | T_INITIATE -> INITIATE + | T_INITIALIZED -> INITIALIZED + | T_INITIALIZE -> INITIALIZE + | T_INITIAL -> INITIAL + | T_INHERITS -> INHERITS + | T_INDICATE -> INDICATE + | T_INDEX_2 -> INDEX_2 + | T_INDEX_1 -> INDEX_1 + | T_INDEXED -> INDEXED + | T_INDEX -> INDEX + | T_INDEPENDENT -> INDEPENDENT + | T_IN -> IN + | T_IMPLEMENTS -> IMPLEMENTS + | T_IGNORING -> IGNORING + | T_IGNORE -> IGNORE + | T_IF -> IF + | T_IDS_II -> IDS_II + | T_IDENTIFIED -> IDENTIFIED + | T_IDENTIFICATION -> IDENTIFICATION + | T_ID -> ID + | T_ICON -> ICON + | T_HSCROLL_POS -> HSCROLL_POS + | T_HSCROLL -> HSCROLL + | T_HOT_TRACK -> HOT_TRACK + | T_HIGH_VALUE -> HIGH_VALUE + | T_HIGH_ORDER_RIGHT -> HIGH_ORDER_RIGHT + | T_HIGH_ORDER_LEFT -> HIGH_ORDER_LEFT + | T_HIGH_COLOR -> HIGH_COLOR + | T_HIGHLIGHT -> HIGHLIGHT + | T_HIDDEN_DATA -> HIDDEN_DATA + | T_HEXLIT -> HEXLIT v + | T_HEX -> HEX + | T_HEIGHT_IN_CELLS -> HEIGHT_IN_CELLS + | T_HEAVY -> HEAVY + | T_HEADING_FONT -> HEADING_FONT + | T_HEADING_DIVIDER_COLOR -> HEADING_DIVIDER_COLOR + | T_HEADING_COLOR -> HEADING_COLOR + | T_HEADING -> HEADING + | T_HAS_CHILDREN -> HAS_CHILDREN + | T_HANDLE -> HANDLE + | T_GT -> GT + | T_GROUP_VALUE -> GROUP_VALUE + | T_GROUP_USAGE -> GROUP_USAGE + | T_GROUP -> GROUP + | T_GRID -> GRID + | T_GREATER -> GREATER + | T_GRAPHICAL -> GRAPHICAL + | T_GO_SEARCH -> GO_SEARCH + | T_GO_HOME -> GO_HOME + | T_GO_FORWARD -> GO_FORWARD + | T_GO_BACK -> GO_BACK + | T_GOBACK -> GOBACK + | T_GO -> GO + | T_GLOBAL -> GLOBAL + | T_GIVING -> GIVING + | T_GET -> GET + | T_GENERATE -> GENERATE + | T_GE -> GE + | T_GCOS -> GCOS + | T_FUNCTION_POINTER -> FUNCTION_POINTER + | T_FUNCTION_ID -> FUNCTION_ID + | T_FUNCTION -> FUNCTION + | T_FULL_HEIGHT -> FULL_HEIGHT + | T_FULL -> FULL + | T_FROM -> FROM + | T_FREE -> FREE + | T_FRAMED -> FRAMED + | T_FRAME -> FRAME + | T_FORMAT -> FORMAT + | T_FOREVER -> FOREVER + | T_FOREGROUND_COLOR -> FOREGROUND_COLOR + | T_FOR -> FOR + | T_FOOTING -> FOOTING + | T_FONT -> FONT + | T_FLR -> FLR + | T_FLOAT_SHORT -> FLOAT_SHORT + | T_FLOAT_NOT_A_NUMBER_SIGNALING -> FLOAT_NOT_A_NUMBER_SIGNALING + | T_FLOAT_NOT_A_NUMBER_QUIET -> FLOAT_NOT_A_NUMBER_QUIET + | T_FLOAT_NOT_A_NUMBER -> FLOAT_NOT_A_NUMBER + | T_FLOAT_LONG -> FLOAT_LONG + | T_FLOAT_INFINITY -> FLOAT_INFINITY + | T_FLOAT_EXTENDED -> FLOAT_EXTENDED + | T_FLOAT_DECIMAL_34 -> FLOAT_DECIMAL_34 + | T_FLOAT_DECIMAL_16 -> FLOAT_DECIMAL_16 + | T_FLOAT_DECIMAL -> FLOAT_DECIMAL + | T_FLOAT_BINARY_64 -> FLOAT_BINARY_64 + | T_FLOAT_BINARY_32 -> FLOAT_BINARY_32 + | T_FLOAT_BINARY_128 -> FLOAT_BINARY_128 + | T_FLOAT_BINARY -> FLOAT_BINARY + | T_FLOATLIT -> FLOATLIT v + | T_FLOATING -> FLOATING + | T_FLOAT -> FLOAT + | T_FLAT_BUTTONS -> FLAT_BUTTONS + | T_FLAT -> FLAT + | T_FIXED_WIDTH -> FIXED_WIDTH + | T_FIXED_FONT -> FIXED_FONT + | T_FIXEDLIT -> FIXEDLIT v + | T_FIXED -> FIXED + | T_FIRST -> FIRST + | T_FINISH_REASON -> FINISH_REASON + | T_FINALLY -> FINALLY + | T_FINAL -> FINAL + | T_FILL_PERCENT -> FILL_PERCENT + | T_FILL_COLOR2 -> FILL_COLOR2 + | T_FILL_COLOR -> FILL_COLOR + | T_FILLER -> FILLER + | T_FILE_POS -> FILE_POS + | T_FILE_NAME -> FILE_NAME + | T_FILE_LIMITS -> FILE_LIMITS + | T_FILE_LIMIT -> FILE_LIMIT + | T_FILE_ID -> FILE_ID + | T_FILE_CONTROL -> FILE_CONTROL + | T_FILES -> FILES + | T_FILE -> FILE + | T_FH__KEYDEF -> FH__KEYDEF + | T_FH__FCD -> FH__FCD + | T_FD -> FD + | T_FARTHEST_FROM_ZERO -> FARTHEST_FROM_ZERO + | T_FALSE -> FALSE + | T_FACTORY -> FACTORY + | T_F -> F + | T_EXTERNAL_FORM -> EXTERNAL_FORM + | T_EXTERNAL -> EXTERNAL + | T_EXTERN -> EXTERN + | T_EXTENDED_SEARCH -> EXTENDED_SEARCH + | T_EXTEND -> EXTEND + | T_EXPANDS -> EXPANDS + | T_EXPAND -> EXPAND + | T_EXIT -> EXIT + | T_EXHIBIT -> EXHIBIT + | T_EXCLUSIVE_OR -> EXCLUSIVE_OR + | T_EXCLUSIVE -> EXCLUSIVE + | T_EXCEPTION_VALUE -> EXCEPTION_VALUE + | T_EXCEPTION_OBJECT -> EXCEPTION_OBJECT + | T_EXCEPTION -> EXCEPTION + | T_EXAMINE -> EXAMINE + | T_EVERY -> EVERY + | T_EVENT_LIST -> EVENT_LIST + | T_EVENT -> EVENT + | T_EVALUATE -> EVALUATE + | T_ESI -> ESI + | T_ESCAPE_BUTTON -> ESCAPE_BUTTON + | T_ESCAPE -> ESCAPE + | T_ERROR -> ERROR + | T_ERASE -> ERASE + | T_EQUAL -> EQUAL + | T_EQ -> EQ + | T_EOS -> EOS + | T_EOP -> EOP + | T_EOL -> EOL + | T_EOF -> EOF + | T_EO -> EO + | T_ENVIRONMENT_VALUE -> ENVIRONMENT_VALUE + | T_ENVIRONMENT_NAME -> ENVIRONMENT_NAME + | T_ENVIRONMENT -> ENVIRONMENT + | T_ENTRY_REASON -> ENTRY_REASON + | T_ENTRY_FIELD -> ENTRY_FIELD + | T_ENTRY_CONVENTION -> ENTRY_CONVENTION + | T_ENTRY -> ENTRY + | T_ENTER -> ENTER + | T_ENSURE_VISIBLE -> ENSURE_VISIBLE + | T_ENGRAVED -> ENGRAVED + | T_END_XML -> END_XML + | T_END_WRITE -> END_WRITE + | T_END_UNSTRING -> END_UNSTRING + | T_END_SUBTRACT -> END_SUBTRACT + | T_END_STRING -> END_STRING + | T_END_START -> END_START + | T_END_SEND -> END_SEND + | T_END_SEARCH -> END_SEARCH + | T_END_REWRITE -> END_REWRITE + | T_END_RETURN -> END_RETURN + | T_END_RECEIVE -> END_RECEIVE + | T_END_READ -> END_READ + | T_END_PERFORM -> END_PERFORM + | T_END_OF_PAGE -> END_OF_PAGE + | T_END_MULTIPLY -> END_MULTIPLY + | T_END_MODIFY -> END_MODIFY + | T_END_JSON -> END_JSON + | T_END_IF -> END_IF + | T_END_EVALUATE -> END_EVALUATE + | T_END_DIVIDE -> END_DIVIDE + | T_END_DISPLAY -> END_DISPLAY + | T_END_DELETE -> END_DELETE + | T_END_COMPUTE -> END_COMPUTE + | T_END_COLOR -> END_COLOR + | T_END_CHAIN -> END_CHAIN + | T_END_CALL -> END_CALL + | T_END_ADD -> END_ADD + | T_END_ACCEPT -> END_ACCEPT + | T_ENDING -> ENDING + | T_END -> END + | T_ENCRYPTION -> ENCRYPTION + | T_ENCODING -> ENCODING + | T_ENABLE -> ENABLE + | T_EMI -> EMI + | T_ELSE -> ELSE + | T_ELEMENT -> ELEMENT + | T_EIGHTY_EIGHT -> EIGHTY_EIGHT + | T_EGI -> EGI + | T_EDITING -> EDITING + | T_ECHO -> ECHO + | T_EC -> EC + | T_EBCDIC -> EBCDIC + | T_DYNAMIC -> DYNAMIC + | T_DUPLICATES -> DUPLICATES + | T_DROP_LIST -> DROP_LIST + | T_DROP_DOWN -> DROP_DOWN + | T_DRAG_COLOR -> DRAG_COLOR + | T_DOWN -> DOWN + | T_DOUBLE_COLON -> DOUBLE_COLON + | T_DOUBLE_ASTERISK -> DOUBLE_ASTERISK + | T_DOUBLE -> DOUBLE + | T_DOTTED -> DOTTED + | T_DOTDASH -> DOTDASH + | T_DIVISION -> DIVISION + | T_DIVIDER_COLOR -> DIVIDER_COLOR + | T_DIVIDERS -> DIVIDERS + | T_DIVIDE -> DIVIDE + | T_DISPLAY_FORMAT -> DISPLAY_FORMAT + | T_DISPLAY_COLUMNS -> DISPLAY_COLUMNS + | T_DISPLAY_4 -> DISPLAY_4 + | T_DISPLAY_3 -> DISPLAY_3 + | T_DISPLAY_2 -> DISPLAY_2 + | T_DISPLAY_1 -> DISPLAY_1 + | T_DISPLAY -> DISPLAY + | T_DISP -> DISP + | T_DISK -> DISK + | T_DISCONNECT -> DISCONNECT + | T_DISC -> DISC + | T_DISABLE -> DISABLE + | T_DIGITS -> DIGITS v + | T_DETAIL -> DETAIL + | T_DESTROY -> DESTROY + | T_DESTINATION -> DESTINATION + | T_DESCENDING -> DESCENDING + | T_DEPENDING -> DEPENDING + | T_DELIMITER -> DELIMITER + | T_DELIMITED -> DELIMITED + | T_DELETE -> DELETE + | T_DEFINITION -> DEFINITION + | T_DEFAULT_FONT -> DEFAULT_FONT + | T_DEFAULT_BUTTON -> DEFAULT_BUTTON + | T_DEFAULT -> DEFAULT + | T_DECLARATIVES -> DECLARATIVES + | T_DECIMAL_POINT -> DECIMAL_POINT + | T_DECIMAL_ENCODING -> DECIMAL_ENCODING + | T_DEBUG_SUB_3 -> DEBUG_SUB_3 + | T_DEBUG_SUB_2 -> DEBUG_SUB_2 + | T_DEBUG_SUB_1 -> DEBUG_SUB_1 + | T_DEBUG_NAME -> DEBUG_NAME + | T_DEBUG_LINE -> DEBUG_LINE + | T_DEBUG_ITEM -> DEBUG_ITEM + | T_DEBUG_CONTENTS -> DEBUG_CONTENTS + | T_DEBUGGING -> DEBUGGING + | T_DAY_OF_WEEK -> DAY_OF_WEEK + | T_DAY -> DAY + | T_DATE_WRITTEN -> DATE_WRITTEN v + | T_DATE_MODIFIED -> DATE_MODIFIED v + | T_DATE_ENTRY -> DATE_ENTRY + | T_DATE_COMPILED -> DATE_COMPILED v + | T_DATE -> DATE + | T_DATA_TYPES -> DATA_TYPES + | T_DATA_RECORDS -> DATA_RECORDS + | T_DATA_RECORD -> DATA_RECORD + | T_DATA_POINTER -> DATA_POINTER + | T_DATA_COLUMNS -> DATA_COLUMNS + | T_DATA -> DATA + | T_DASH_SIGN -> DASH_SIGN + | T_DASHED -> DASHED + | T_CYL_OVERFLOW -> CYL_OVERFLOW + | T_CYL_INDEX -> CYL_INDEX + | T_CYCLE -> CYCLE + | T_CUSTOM_PRINT_TEMPLATE -> CUSTOM_PRINT_TEMPLATE + | T_CURSOR_Y -> CURSOR_Y + | T_CURSOR_X -> CURSOR_X + | T_CURSOR_ROW -> CURSOR_ROW + | T_CURSOR_FRAME_WIDTH -> CURSOR_FRAME_WIDTH + | T_CURSOR_COLOR -> CURSOR_COLOR + | T_CURSOR_COL -> CURSOR_COL + | T_CURSOR -> CURSOR + | T_CURRENT -> CURRENT + | T_CURRENCY -> CURRENCY + | T_CS_GENERAL -> CS_GENERAL + | T_CS_BASIC -> CS_BASIC + | T_CSIZE -> CSIZE + | T_CRT_UNDER -> CRT_UNDER + | T_CRT -> CRT + | T_COUNT -> COUNT + | T_CORRESPONDING -> CORRESPONDING + | T_CORE_INDEX -> CORE_INDEX + | T_COPY_SELECTION -> COPY_SELECTION + | T_COPY -> COPY + | T_CONVERTING -> CONVERTING + | T_CONVERSION -> CONVERSION + | T_CONTROLS -> CONTROLS + | T_CONTROL -> CONTROL + | T_CONTINUE -> CONTINUE + | T_CONTENT -> CONTENT + | T_CONTAINS -> CONTAINS + | T_CONSTANT -> CONSTANT + | T_CONSOLE_3 -> CONSOLE_3 + | T_CONSOLE_2 -> CONSOLE_2 + | T_CONSOLE_1 -> CONSOLE_1 + | T_CONSOLE_0 -> CONSOLE_0 + | T_CONNECT -> CONNECT + | T_CONFIGURATION -> CONFIGURATION + | T_CONDITION -> CONDITION + | T_COMP_X -> COMP_X + | T_COMP_N -> COMP_N + | T_COMP_9 -> COMP_9 + | T_COMP_7 -> COMP_7 + | T_COMP_6 -> COMP_6 + | T_COMP_5 -> COMP_5 + | T_COMP_4 -> COMP_4 + | T_COMP_3 -> COMP_3 + | T_COMP_2 -> COMP_2 + | T_COMP_15 -> COMP_15 + | T_COMP_14 -> COMP_14 + | T_COMP_13 -> COMP_13 + | T_COMP_12 -> COMP_12 + | T_COMP_11 -> COMP_11 + | T_COMP_10 -> COMP_10 + | T_COMP_1 -> COMP_1 + | T_COMP_0 -> COMP_0 + | T_COMPUTE -> COMPUTE + | T_COMPUTATIONAL_7 -> COMPUTATIONAL_7 + | T_COMPUTATIONAL_14 -> COMPUTATIONAL_14 + | T_COMPUTATIONAL_13 -> COMPUTATIONAL_13 + | T_COMPUTATIONAL_12 -> COMPUTATIONAL_12 + | T_COMPUTATIONAL_11 -> COMPUTATIONAL_11 + | T_COMPLEMENTARY -> COMPLEMENTARY + | T_COMPLE -> COMPLE + | T_COMP -> COMP + | T_COMMUNICATION -> COMMUNICATION + | T_COMMON -> COMMON + | T_COMMIT -> COMMIT + | T_COMMAND_LINE -> COMMAND_LINE + | T_COMMA -> COMMA + | T_COMBO_BOX -> COMBO_BOX + | T_COLUMN_PROTECTION -> COLUMN_PROTECTION + | T_COLUMN_HEADINGS -> COLUMN_HEADINGS + | T_COLUMN_FONT -> COLUMN_FONT + | T_COLUMN_DIVIDERS -> COLUMN_DIVIDERS + | T_COLUMN_COLOR -> COLUMN_COLOR + | T_COLUMNS -> COLUMNS + | T_COLUMN -> COLUMN + | T_COLORS -> COLORS + | T_COLOR -> COLOR + | T_COLON -> COLON + | T_COLLATING -> COLLATING + | T_COL -> COL + | T_CODE_SET -> CODE_SET + | T_CODE -> CODE + | T_COBOL -> COBOL + | T_CLOSE -> CLOSE + | T_CLOCK_UNITS -> CLOCK_UNITS + | T_CLINES -> CLINES + | T_CLINE -> CLINE + | T_CLEAR_SELECTION -> CLEAR_SELECTION + | T_CLASS_ID -> CLASS_ID + | T_CLASSIFICATION -> CLASSIFICATION + | T_CLASS -> CLASS + | T_CHECK_BOX -> CHECK_BOX + | T_CHECKPOINT_FILE -> CHECKPOINT_FILE + | T_CHECK -> CHECK + | T_CHARACTERS -> CHARACTERS + | T_CHARACTER -> CHARACTER + | T_CHANGED -> CHANGED + | T_CHAINING -> CHAINING + | T_CHAIN -> CHAIN + | T_CH -> CH + | T_CF -> CF + | T_CENTURY_DATE -> CENTURY_DATE + | T_CENTERED_HEADINGS -> CENTERED_HEADINGS + | T_CENTERED -> CENTERED + | T_CENTER -> CENTER + | T_CELL_PROTECTION -> CELL_PROTECTION + | T_CELL_FONT -> CELL_FONT + | T_CELL_DATA -> CELL_DATA + | T_CELL_COLOR -> CELL_COLOR + | T_CELL -> CELL + | T_CD -> CD + | T_CCOL -> CCOL + | T_CATALOGUE_NAME -> CATALOGUE_NAME + | T_CATALOGUED -> CATALOGUED + | T_CASSETTE -> CASSETTE + | T_CARD_READER -> CARD_READER + | T_CARD_PUNCH -> CARD_PUNCH + | T_CAPACITY -> CAPACITY + | T_CANCEL_BUTTON -> CANCEL_BUTTON + | T_CANCEL -> CANCEL + | T_CALL -> CALL + | T_CALENDAR_FONT -> CALENDAR_FONT + | T_C -> C + | T_B_XOR -> B_XOR + | T_B_SHIFT_RC -> B_SHIFT_RC + | T_B_SHIFT_R -> B_SHIFT_R + | T_B_SHIFT_LC -> B_SHIFT_LC + | T_B_SHIFT_L -> B_SHIFT_L + | T_B_OR -> B_OR + | T_B_NOT -> B_NOT + | T_B_EXOR -> B_EXOR + | T_B_AND -> B_AND + | T_BYTE_LENGTH -> BYTE_LENGTH + | T_BYTES -> BYTES + | T_BYTE -> BYTE + | T_BY -> BY + | T_BUTTONS -> BUTTONS + | T_BUSY -> BUSY + | T_BULK_ADDITION -> BULK_ADDITION + | T_BSN -> BSN + | T_BOXED -> BOXED + | T_BOX -> BOX + | T_BOTTOM -> BOTTOM + | T_BOOLIT -> BOOLIT v + | T_BOOLEAN -> BOOLEAN + | T_BLOCK -> BLOCK + | T_BLINK -> BLINK + | T_BLANK -> BLANK + | T_BITS -> BITS + | T_BITMAP_WIDTH -> BITMAP_WIDTH + | T_BITMAP_TRANSPARENT_COLOR -> BITMAP_TRANSPARENT_COLOR + | T_BITMAP_TRAILING -> BITMAP_TRAILING + | T_BITMAP_TIMER -> BITMAP_TIMER + | T_BITMAP_START -> BITMAP_START + | T_BITMAP_NUMBER -> BITMAP_NUMBER + | T_BITMAP_HANDLE -> BITMAP_HANDLE + | T_BITMAP_END -> BITMAP_END + | T_BITMAP -> BITMAP + | T_BIT -> BIT + | T_BINARY_SHORT -> BINARY_SHORT + | T_BINARY_SEQUENTIAL -> BINARY_SEQUENTIAL + | T_BINARY_LONG -> BINARY_LONG + | T_BINARY_ENCODING -> BINARY_ENCODING + | T_BINARY_DOUBLE -> BINARY_DOUBLE + | T_BINARY_C_LONG -> BINARY_C_LONG + | T_BINARY_CHAR -> BINARY_CHAR + | T_BINARY -> BINARY + | T_BELL -> BELL + | T_BEGINNING -> BEGINNING + | T_BEFORE -> BEFORE + | T_BECOMES -> BECOMES + | T_BASED -> BASED + | T_BAR -> BAR + | T_BACKWARD -> BACKWARD + | T_BACKGROUND_STANDARD -> BACKGROUND_STANDARD + | T_BACKGROUND_LOW -> BACKGROUND_LOW + | T_BACKGROUND_HIGH -> BACKGROUND_HIGH + | T_BACKGROUND_COLOR -> BACKGROUND_COLOR + | T_AWAY_FROM_ZERO -> AWAY_FROM_ZERO + | T_AUTO_SPIN -> AUTO_SPIN + | T_AUTO_DECIMAL -> AUTO_DECIMAL + | T_AUTOMATIC -> AUTOMATIC + | T_AUTO -> AUTO + | T_AUTHOR -> AUTHOR v + | T_AT_EOP -> AT_EOP + | T_AT_END -> AT_END + | T_ATTRIBUTES -> ATTRIBUTES + | T_ATTRIBUTE -> ATTRIBUTE + | T_AT -> AT + | T_ASTERISK -> ASTERISK + | T_ASSIGN -> ASSIGN + | T_ASCII -> ASCII + | T_ASCENDING -> ASCENDING + | T_ASA -> ASA + | T_AS -> AS + | T_ARITHMETIC -> ARITHMETIC + | T_ARGUMENT_VALUE -> ARGUMENT_VALUE + | T_ARGUMENT_NUMBER -> ARGUMENT_NUMBER + | T_AREAS -> AREAS + | T_AREA -> AREA + | T_ARE -> ARE + | T_APPLY -> APPLY + | T_ANYCASE -> ANYCASE + | T_ANY -> ANY + | T_ANUM -> ANUM + | T_ANSI -> ANSI + | T_AND -> AND + | T_AMPERSAND -> AMPERSAND + | T_ALTERNATE -> ALTERNATE + | T_ALTERING -> ALTERING + | T_ALTER -> ALTER + | T_ALSO -> ALSO + | T_ALPHANUM_PREFIX -> ALPHANUM_PREFIX v + | T_ALPHANUMERIC_EDITED -> ALPHANUMERIC_EDITED + | T_ALPHANUMERIC -> ALPHANUMERIC + | T_ALPHANUM -> ALPHANUM v + | T_ALPHABETIC_UPPER -> ALPHABETIC_UPPER + | T_ALPHABETIC_LOWER -> ALPHABETIC_LOWER + | T_ALPHABETIC -> ALPHABETIC + | T_ALPHABET -> ALPHABET + | T_ALLOWING -> ALLOWING + | T_ALLOCATE -> ALLOCATE + | T_ALL -> ALL + | T_ALIGNMENT -> ALIGNMENT + | T_ALIGNED -> ALIGNED + | T_ALIAS -> ALIAS + | T_AFTER -> AFTER + | T_ADVANCING -> ADVANCING + | T_ADJUSTABLE_COLUMNS -> ADJUSTABLE_COLUMNS + | T_ADDRESS -> ADDRESS + | T_ADD -> ADD + | T_ACTUAL -> ACTUAL + | T_ACTIVE_X -> ACTIVE_X + | T_ACTIVE_CLASS -> ACTIVE_CLASS + | T_ACTIVATING -> ACTIVATING + | T_ACTION -> ACTION + | T_ACCESS -> ACCESS + | T_ACCEPT -> ACCEPT + | T_ABSENT -> ABSENT diff --git a/src/lsp/cobol_parser/grammar_printer.mli b/src/lsp/cobol_parser/grammar_printer.mli new file mode 100644 index 000000000..4e6016422 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_printer.mli @@ -0,0 +1,18 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Grammar + +val token_of_terminal : 'a MenhirInterpreter.terminal -> 'a -> token +val print_symbol : Grammar.MenhirInterpreter.xsymbol -> string +val print_token : Grammar.token -> string diff --git a/src/lsp/cobol_parser/grammar_recover.ml b/src/lsp/cobol_parser/grammar_recover.ml new file mode 100644 index 000000000..26ada9aad --- /dev/null +++ b/src/lsp/cobol_parser/grammar_recover.ml @@ -0,0 +1,9241 @@ +open Grammar + +module Default = struct + + let fixed_zero = Cobol_ast.{ fixed_integer = "0"; + fixed_fractional = "0" } + + let floating_zero = Cobol_ast.{ float_significand = fixed_zero; + float_exponent = "1" } + + let boolean_zero = Cobol_ast.{ bool_base = `Bool; + bool_value = "0" } + + + open Cobol_common.Srcloc.INFIX + + let dummy_loc = + Grammar_utils.Overlay_manager.(join_limits (dummy_limit, dummy_limit)) + + let dummy_name = "_" &@ dummy_loc + + let dummy_qualname: Cobol_ast.qualname = + Cobol_ast.Name dummy_name + + let dummy_qualident = + Cobol_ast.{ ident_name = dummy_qualname; + ident_refmod = None; + ident_subscripts = [] } + + let dummy_ident = + Cobol_ast.QualIdent dummy_qualident + + let dummy_expr = + Cobol_ast.Atom (Fig Zero) + + let dummy_picture = + PTree.{ picture = "X" &@ dummy_loc; + picture_locale = None; + picture_depending = None } + + let value (type a) : a MenhirInterpreter.symbol -> a = function + | MenhirInterpreter.T T_error -> () + | MenhirInterpreter.T T_ZERO_FILL -> () + | MenhirInterpreter.T T_ZERO -> () + | MenhirInterpreter.T T_YYYYMMDD -> () + | MenhirInterpreter.T T_YYYYDDD -> () + | MenhirInterpreter.T T_Y -> () + | MenhirInterpreter.T T_XOR -> () + | MenhirInterpreter.T T_XML_SCHEMA -> () + | MenhirInterpreter.T T_XML_DECLARATION -> () + | MenhirInterpreter.T T_XML -> () + | MenhirInterpreter.T T_X -> () + | MenhirInterpreter.T T_WRITE_VERIFY -> () + | MenhirInterpreter.T T_WRITE_ONLY -> () + | MenhirInterpreter.T T_WRITERS -> () + | MenhirInterpreter.T T_WRITE -> () + | MenhirInterpreter.T T_WRAP -> () + | MenhirInterpreter.T T_WORKING_STORAGE -> () + | MenhirInterpreter.T T_WORD_IN_AREA_A -> "_" + | MenhirInterpreter.T T_WORDS -> () + | MenhirInterpreter.T T_WORD -> "_" + | MenhirInterpreter.T T_WITH_DATA -> () + | MenhirInterpreter.T T_WITH -> () + | MenhirInterpreter.T T_WINDOW -> () + | MenhirInterpreter.T T_WIDTH_IN_CELLS -> () + | MenhirInterpreter.T T_WIDTH -> () + | MenhirInterpreter.T T_WHEN -> () + | MenhirInterpreter.T T_WEB_BROWSER -> () + | MenhirInterpreter.T T_WAIT -> () + | MenhirInterpreter.T T_VTOP -> () + | MenhirInterpreter.T T_VSCROLL_POS -> () + | MenhirInterpreter.T T_VSCROLL_BAR -> () + | MenhirInterpreter.T T_VSCROLL -> () + | MenhirInterpreter.T T_VPADDING -> () + | MenhirInterpreter.T T_VOLATILE -> () + | MenhirInterpreter.T T_VLR -> () + | MenhirInterpreter.T T_VIRTUAL_WIDTH -> () + | MenhirInterpreter.T T_VIRTUAL -> () + | MenhirInterpreter.T T_VIA -> () + | MenhirInterpreter.T T_VERY_HEAVY -> () + | MenhirInterpreter.T T_VERTICAL -> () + | MenhirInterpreter.T T_VARYING -> () + | MenhirInterpreter.T T_VARIANT -> () + | MenhirInterpreter.T T_VARIABLE -> () + | MenhirInterpreter.T T_VALUE_FORMAT -> () + | MenhirInterpreter.T T_VALUES -> () + | MenhirInterpreter.T T_VALUE -> () + | MenhirInterpreter.T T_VALIDATING -> () + | MenhirInterpreter.T T_VALIDATE_STATUS -> () + | MenhirInterpreter.T T_VALIDATE -> () + | MenhirInterpreter.T T_VALID -> () + | MenhirInterpreter.T T_V -> () + | MenhirInterpreter.T T_UTF_8 -> () + | MenhirInterpreter.T T_UTF_16 -> () + | MenhirInterpreter.T T_USING -> () + | MenhirInterpreter.T T_USE_TAB -> () + | MenhirInterpreter.T T_USE_RETURN -> () + | MenhirInterpreter.T T_USE_ALT -> () + | MenhirInterpreter.T T_USER_DEFAULT -> () + | MenhirInterpreter.T T_USER -> () + | MenhirInterpreter.T T_USE -> () + | MenhirInterpreter.T T_USAGE -> () + | MenhirInterpreter.T T_UPPER -> () + | MenhirInterpreter.T T_UPON -> () + | MenhirInterpreter.T T_UPDATERS -> () + | MenhirInterpreter.T T_UPDATE -> () + | MenhirInterpreter.T T_UP -> () + | MenhirInterpreter.T T_UNUSED__ -> () + | MenhirInterpreter.T T_UNTIL -> () + | MenhirInterpreter.T T_UNSTRING -> () + | MenhirInterpreter.T T_UNSORTED -> () + | MenhirInterpreter.T T_UNSIGNED_SHORT -> () + | MenhirInterpreter.T T_UNSIGNED_LONG -> () + | MenhirInterpreter.T T_UNSIGNED_INT -> () + | MenhirInterpreter.T T_UNSIGNED -> () + | MenhirInterpreter.T T_UNSEQUAL -> () + | MenhirInterpreter.T T_UNLOCK -> () + | MenhirInterpreter.T T_UNIVERSAL -> () + | MenhirInterpreter.T T_UNIT -> () + | MenhirInterpreter.T T_UNFRAMED -> () + | MenhirInterpreter.T T_UNDERLINE -> () + | MenhirInterpreter.T T_UNBOUNDED -> () + | MenhirInterpreter.T T_UFF -> () + | MenhirInterpreter.T T_UCS_4 -> () + | MenhirInterpreter.T T_U -> () + | MenhirInterpreter.T T_TYPEDEF -> () + | MenhirInterpreter.T T_TYPE -> () + | MenhirInterpreter.T T_TRUNCATION -> () + | MenhirInterpreter.T T_TRUE -> () + | MenhirInterpreter.T T_TREE_VIEW -> () + | MenhirInterpreter.T T_TRANSPARENT -> () + | MenhirInterpreter.T T_TRANSFORM -> () + | MenhirInterpreter.T T_TRAILING_SIGN -> () + | MenhirInterpreter.T T_TRAILING_SHIFT -> () + | MenhirInterpreter.T T_TRAILING -> () + | MenhirInterpreter.T T_TRADITIONAL_FONT -> () + | MenhirInterpreter.T T_TRACK_LIMIT -> () + | MenhirInterpreter.T T_TRACK_AREA -> () + | MenhirInterpreter.T T_TRACKS -> () + | MenhirInterpreter.T T_TRACK -> () + | MenhirInterpreter.T T_TOWARD_LESSER -> () + | MenhirInterpreter.T T_TOWARD_GREATER -> () + | MenhirInterpreter.T T_TOP_LEVEL -> () + | MenhirInterpreter.T T_TOP -> () + | MenhirInterpreter.T T_TO -> () + | MenhirInterpreter.T T_TITLE_POSITION -> () + | MenhirInterpreter.T T_TITLE -> () + | MenhirInterpreter.T T_TIME_OUT -> () + | MenhirInterpreter.T T_TIMES -> () + | MenhirInterpreter.T T_TIME -> () + | MenhirInterpreter.T T_TILED_HEADINGS -> () + | MenhirInterpreter.T T_THUMB_POSITION -> () + | MenhirInterpreter.T T_THROUGH -> () + | MenhirInterpreter.T T_THREEDIMENSIONAL -> () + | MenhirInterpreter.T T_THREADS -> () + | MenhirInterpreter.T T_THREAD -> () + | MenhirInterpreter.T T_THEN -> () + | MenhirInterpreter.T T_THAN -> () + | MenhirInterpreter.T T_TEXT -> () + | MenhirInterpreter.T T_TEST -> () + | MenhirInterpreter.T T_TERMINATION_VALUE -> () + | MenhirInterpreter.T T_TERMINATE -> () + | MenhirInterpreter.T T_TERMINAL_X -> () + | MenhirInterpreter.T T_TERMINAL_INFO -> () + | MenhirInterpreter.T T_TERMINAL_3 -> () + | MenhirInterpreter.T T_TERMINAL_2 -> () + | MenhirInterpreter.T T_TERMINAL_1 -> () + | MenhirInterpreter.T T_TERMINAL_0 -> () + | MenhirInterpreter.T T_TERMINAL -> () + | MenhirInterpreter.T T_TEMPORARY -> () + | MenhirInterpreter.T T_TEMP -> () + | MenhirInterpreter.T T_TAPE -> () + | MenhirInterpreter.T T_TALLYING -> () + | MenhirInterpreter.T T_TAB_TO_DELETE -> () + | MenhirInterpreter.T T_TAB_TO_ADD -> () + | MenhirInterpreter.T T_TABLE -> () + | MenhirInterpreter.T T_TAB -> () + | MenhirInterpreter.T T_SYSTEM_OFFSET -> () + | MenhirInterpreter.T T_SYSTEM_INFO -> () + | MenhirInterpreter.T T_SYSTEM_DEFAULT -> () + | MenhirInterpreter.T T_SYSTEM -> () + | MenhirInterpreter.T T_SYSOUT_X -> () + | MenhirInterpreter.T T_SYSOUT_3 -> () + | MenhirInterpreter.T T_SYSOUT_2 -> () + | MenhirInterpreter.T T_SYSOUT_1 -> () + | MenhirInterpreter.T T_SYSOUT_0 -> () + | MenhirInterpreter.T T_SYSIN_X -> () + | MenhirInterpreter.T T_SYSIN_3 -> () + | MenhirInterpreter.T T_SYSIN_2 -> () + | MenhirInterpreter.T T_SYSIN_1 -> () + | MenhirInterpreter.T T_SYSIN_0 -> () + | MenhirInterpreter.T T_SYNCHRONIZED -> () + | MenhirInterpreter.T T_SYMBOLIC -> () + | MenhirInterpreter.T T_SYMBOL -> () + | MenhirInterpreter.T T_SWITCH -> () + | MenhirInterpreter.T T_SUPPRESS -> () + | MenhirInterpreter.T T_SUPER -> () + | MenhirInterpreter.T T_SUM -> () + | MenhirInterpreter.T T_SUB_SCHEMA -> () + | MenhirInterpreter.T T_SUB_QUEUE_3 -> () + | MenhirInterpreter.T T_SUB_QUEUE_2 -> () + | MenhirInterpreter.T T_SUB_QUEUE_1 -> () + | MenhirInterpreter.T T_SUBWINDOW -> () + | MenhirInterpreter.T T_SUBTRACT -> () + | MenhirInterpreter.T T_STYLE -> () + | MenhirInterpreter.T T_STRUCTURE -> () + | MenhirInterpreter.T T_STRONG -> () + | MenhirInterpreter.T T_STRING -> () + | MenhirInterpreter.T T_STOP -> () + | MenhirInterpreter.T T_STEP -> () + | MenhirInterpreter.T T_STDCALL -> () + | MenhirInterpreter.T T_STATUS_TEXT -> () + | MenhirInterpreter.T T_STATUS_BAR -> () + | MenhirInterpreter.T T_STATUS -> () + | MenhirInterpreter.T T_STATION -> () + | MenhirInterpreter.T T_STATIC_LIST -> () + | MenhirInterpreter.T T_STATIC -> () + | MenhirInterpreter.T T_STATEMENT -> () + | MenhirInterpreter.T T_START_Y -> () + | MenhirInterpreter.T T_START_X -> () + | MenhirInterpreter.T T_START -> () + | MenhirInterpreter.T T_STANDARD_DECIMAL -> () + | MenhirInterpreter.T T_STANDARD_BINARY -> () + | MenhirInterpreter.T T_STANDARD_2 -> () + | MenhirInterpreter.T T_STANDARD_1 -> () + | MenhirInterpreter.T T_STANDARD -> () + | MenhirInterpreter.T T_STACK -> () + | MenhirInterpreter.T T_SSF -> () + | MenhirInterpreter.T T_SQUARE -> () + | MenhirInterpreter.T T_SPINNER -> () + | MenhirInterpreter.T T_SPECIAL_NAMES -> () + | MenhirInterpreter.T T_SPACE_FILL -> () + | MenhirInterpreter.T T_SPACE -> () + | MenhirInterpreter.T T_SOURCE_COMPUTER -> () + | MenhirInterpreter.T T_SOURCES -> () + | MenhirInterpreter.T T_SOURCE -> () + | MenhirInterpreter.T T_SORT_ORDER -> () + | MenhirInterpreter.T T_SORT_MERGE -> () + | MenhirInterpreter.T T_SORT -> () + | MenhirInterpreter.T T_SMALL_FONT -> () + | MenhirInterpreter.T T_SLASH -> () + | MenhirInterpreter.T T_SIZE -> () + | MenhirInterpreter.T T_SINTLIT -> "0" + | MenhirInterpreter.T T_SIGNED_SHORT -> () + | MenhirInterpreter.T T_SIGNED_LONG -> () + | MenhirInterpreter.T T_SIGNED_INT -> () + | MenhirInterpreter.T T_SIGNED -> () + | MenhirInterpreter.T T_SIGN -> () + | MenhirInterpreter.T T_SHOW_SEL_ALWAYS -> () + | MenhirInterpreter.T T_SHOW_NONE -> () + | MenhirInterpreter.T T_SHOW_LINES -> () + | MenhirInterpreter.T T_SHORT_DATE -> () + | MenhirInterpreter.T T_SHORT -> () + | MenhirInterpreter.T T_SHARING -> () + | MenhirInterpreter.T T_SHADOW -> () + | MenhirInterpreter.T T_SHADING -> () + | MenhirInterpreter.T T_SET -> () + | MenhirInterpreter.T T_SEQUENTIAL -> () + | MenhirInterpreter.T T_SEQUENCE -> () + | MenhirInterpreter.T T_SEPARATION -> () + | MenhirInterpreter.T T_SEPARATE -> () + | MenhirInterpreter.T T_SENTENCE -> () + | MenhirInterpreter.T T_SEND -> () + | MenhirInterpreter.T T_SELF_ACT -> () + | MenhirInterpreter.T T_SELF -> () + | MenhirInterpreter.T T_SELECT_ALL -> () + | MenhirInterpreter.T T_SELECTION_TEXT -> () + | MenhirInterpreter.T T_SELECTION_INDEX -> () + | MenhirInterpreter.T T_SELECTION -> () + | MenhirInterpreter.T T_SELECT -> () + | MenhirInterpreter.T T_SEGMENT_LIMIT -> () + | MenhirInterpreter.T T_SEGMENT -> () + | MenhirInterpreter.T T_SECURITY -> "_" + | MenhirInterpreter.T T_SECURE -> () + | MenhirInterpreter.T T_SECTION -> () + | MenhirInterpreter.T T_SECONDS -> () + | MenhirInterpreter.T T_SECONDARY -> () + | MenhirInterpreter.T T_SEARCH_TEXT -> () + | MenhirInterpreter.T T_SEARCH_OPTIONS -> () + | MenhirInterpreter.T T_SEARCH -> () + | MenhirInterpreter.T T_SD -> () + | MenhirInterpreter.T T_SCROLL_BAR -> () + | MenhirInterpreter.T T_SCROLL -> () + | MenhirInterpreter.T T_SCREEN -> () + | MenhirInterpreter.T T_SAVE_AS_NO_PROMPT -> () + | MenhirInterpreter.T T_SAVE_AS -> () + | MenhirInterpreter.T T_SARF -> () + | MenhirInterpreter.T T_SAME -> () + | MenhirInterpreter.T T_S -> () + | MenhirInterpreter.T T_RUN -> () + | MenhirInterpreter.T T_RPAR -> () + | MenhirInterpreter.T T_ROW_PROTECTION -> () + | MenhirInterpreter.T T_ROW_HEADINGS -> () + | MenhirInterpreter.T T_ROW_FONT -> () + | MenhirInterpreter.T T_ROW_DIVIDERS -> () + | MenhirInterpreter.T T_ROW_COLOR_PATTERN -> () + | MenhirInterpreter.T T_ROW_COLOR -> () + | MenhirInterpreter.T T_ROUNDING -> () + | MenhirInterpreter.T T_ROUNDED -> () + | MenhirInterpreter.T T_ROLLBACK -> () + | MenhirInterpreter.T T_RIMMED -> () + | MenhirInterpreter.T T_RIGHT_JUSTIFY -> () + | MenhirInterpreter.T T_RIGHT_ALIGN -> () + | MenhirInterpreter.T T_RIGHT -> () + | MenhirInterpreter.T T_RH -> () + | MenhirInterpreter.T T_RF -> () + | MenhirInterpreter.T T_REWRITE -> () + | MenhirInterpreter.T T_REWIND -> () + | MenhirInterpreter.T T_REVERSE_VIDEO -> () + | MenhirInterpreter.T T_REVERSED -> () + | MenhirInterpreter.T T_REVERSE -> () + | MenhirInterpreter.T T_RETURNING -> () + | MenhirInterpreter.T T_RETURN -> () + | MenhirInterpreter.T T_RETRY -> () + | MenhirInterpreter.T T_RETENTION -> () + | MenhirInterpreter.T T_RESUME -> () + | MenhirInterpreter.T T_RESET_TABS -> () + | MenhirInterpreter.T T_RESET_LIST -> () + | MenhirInterpreter.T T_RESET_GRID -> () + | MenhirInterpreter.T T_RESET -> () + | MenhirInterpreter.T T_RESERVE -> () + | MenhirInterpreter.T T_RERUN -> () + | MenhirInterpreter.T T_REREAD -> () + | MenhirInterpreter.T T_REQUIRED -> () + | MenhirInterpreter.T T_REPOSITORY -> () + | MenhirInterpreter.T T_REPORTS -> () + | MenhirInterpreter.T T_REPORTING -> () + | MenhirInterpreter.T T_REPORT -> () + | MenhirInterpreter.T T_REPLACING -> () + | MenhirInterpreter.T T_REPLACE -> () + | MenhirInterpreter.T T_REPEATED -> () + | MenhirInterpreter.T T_REORG_CRITERIA -> () + | MenhirInterpreter.T T_RENAMES -> () + | MenhirInterpreter.T T_REMOVAL -> () + | MenhirInterpreter.T T_REMARKS -> "_" + | MenhirInterpreter.T T_REMAINDER -> () + | MenhirInterpreter.T T_RELEASE -> () + | MenhirInterpreter.T T_RELATIVE -> () + | MenhirInterpreter.T T_RELATION -> () + | MenhirInterpreter.T T_REGION_COLOR -> () + | MenhirInterpreter.T T_REFRESH -> () + | MenhirInterpreter.T T_REFERENCES -> () + | MenhirInterpreter.T T_REFERENCE -> () + | MenhirInterpreter.T T_REEL -> () + | MenhirInterpreter.T T_REDEFINES -> () + | MenhirInterpreter.T T_RECURSIVE -> () + | MenhirInterpreter.T T_RECORD_TO_DELETE -> () + | MenhirInterpreter.T T_RECORD_TO_ADD -> () + | MenhirInterpreter.T T_RECORD_OVERFLOW -> () + | MenhirInterpreter.T T_RECORD_DATA -> () + | MenhirInterpreter.T T_RECORDS -> () + | MenhirInterpreter.T T_RECORDING -> () + | MenhirInterpreter.T T_RECORD -> () + | MenhirInterpreter.T T_RECEIVED -> () + | MenhirInterpreter.T T_RECEIVE -> () + | MenhirInterpreter.T T_READ_ONLY -> () + | MenhirInterpreter.T T_READERS -> () + | MenhirInterpreter.T T_READ -> () + | MenhirInterpreter.T T_RD -> () + | MenhirInterpreter.T T_RANDOM -> () + | MenhirInterpreter.T T_RAISING -> () + | MenhirInterpreter.T T_RAISED -> () + | MenhirInterpreter.T T_RAISE -> () + | MenhirInterpreter.T T_RADIO_BUTTON -> () + | MenhirInterpreter.T T_QUOTE -> () + | MenhirInterpreter.T T_QUEUED -> () + | MenhirInterpreter.T T_QUEUE -> () + | MenhirInterpreter.T T_QUERY_INDEX -> () + | MenhirInterpreter.T T_PUSH_BUTTON -> () + | MenhirInterpreter.T T_PURGE -> () + | MenhirInterpreter.T T_PROTOTYPE -> () + | MenhirInterpreter.T T_PROTECTED -> () + | MenhirInterpreter.T T_PROPERTY -> () + | MenhirInterpreter.T T_PROPERTIES -> () + | MenhirInterpreter.T T_PROMPT -> () + | MenhirInterpreter.T T_PROHIBITED -> () + | MenhirInterpreter.T T_PROGRESS -> () + | MenhirInterpreter.T T_PROGRAM_POINTER -> () + | MenhirInterpreter.T T_PROGRAM_ID -> () + | MenhirInterpreter.T T_PROGRAM -> () + | MenhirInterpreter.T T_PROCESS_AREA -> () + | MenhirInterpreter.T T_PROCESSING -> () + | MenhirInterpreter.T T_PROCEED -> () + | MenhirInterpreter.T T_PROCEDURE_POINTER -> () + | MenhirInterpreter.T T_PROCEDURES -> () + | MenhirInterpreter.T T_PROCEDURE -> () + | MenhirInterpreter.T T_PRIORITY -> () + | MenhirInterpreter.T T_PRINT_PREVIEW -> () + | MenhirInterpreter.T T_PRINT_NO_PROMPT -> () + | MenhirInterpreter.T T_PRINTING -> () + | MenhirInterpreter.T T_PRINTER_1 -> () + | MenhirInterpreter.T T_PRINTER -> () + | MenhirInterpreter.T T_PRINT -> () + | MenhirInterpreter.T T_PRIMARY -> () + | MenhirInterpreter.T T_PREVIOUS -> () + | MenhirInterpreter.T T_PRESENT -> () + | MenhirInterpreter.T T_PREFIXED -> () + | MenhirInterpreter.T T_POSITIVE -> () + | MenhirInterpreter.T T_POSITION_SHIFT -> () + | MenhirInterpreter.T T_POSITION -> () + | MenhirInterpreter.T T_POS -> () + | MenhirInterpreter.T T_POP_UP -> () + | MenhirInterpreter.T T_POINTER -> () + | MenhirInterpreter.T T_PLUS_SIGN -> () + | MenhirInterpreter.T T_PLUS -> () + | MenhirInterpreter.T T_PLACEMENT -> () + | MenhirInterpreter.T T_PIXEL -> () + | MenhirInterpreter.T T_PICTURE_STRING -> "X" + | MenhirInterpreter.T T_PICTURE -> () + | MenhirInterpreter.T T_PHYSICAL -> () + | MenhirInterpreter.T T_PH -> () + | MenhirInterpreter.T T_PF -> () + | MenhirInterpreter.T T_PERMANENT -> () + | MenhirInterpreter.T T_PERIOD -> () + | MenhirInterpreter.T T_PERFORM -> () + | MenhirInterpreter.T T_PASSWORD -> () + | MenhirInterpreter.T T_PASCAL -> () + | MenhirInterpreter.T T_PARSE -> () + | MenhirInterpreter.T T_PARENT -> () + | MenhirInterpreter.T T_PARAGRAPH -> () + | MenhirInterpreter.T T_PAGE_SETUP -> () + | MenhirInterpreter.T T_PAGE_COUNTER -> () + | MenhirInterpreter.T T_PAGED -> () + | MenhirInterpreter.T T_PAGE -> () + | MenhirInterpreter.T T_PADDING -> () + | MenhirInterpreter.T T_PACKED_DECIMAL -> () + | MenhirInterpreter.T T_OVERRIDING -> () + | MenhirInterpreter.T T_OVERRIDE -> () + | MenhirInterpreter.T T_OVERLINE -> () + | MenhirInterpreter.T T_OVERLAP_TOP -> () + | MenhirInterpreter.T T_OVERLAP_LEFT -> () + | MenhirInterpreter.T T_OVERFLOW -> () + | MenhirInterpreter.T T_OUTPUT -> () + | MenhirInterpreter.T T_OTHERS -> () + | MenhirInterpreter.T T_OTHER -> () + | MenhirInterpreter.T T_ORGANIZATION -> () + | MenhirInterpreter.T T_ORDER -> () + | MenhirInterpreter.T T_OR -> () + | MenhirInterpreter.T T_OPTIONS -> () + | MenhirInterpreter.T T_OPTIONAL -> () + | MenhirInterpreter.T T_OPERATIONAL -> () + | MenhirInterpreter.T T_OPEN -> () + | MenhirInterpreter.T T_ON_SIZE_ERROR -> () + | MenhirInterpreter.T T_ON_OVERFLOW -> () + | MenhirInterpreter.T T_ON_EXCEPTION -> () + | MenhirInterpreter.T T_ONLY -> () + | MenhirInterpreter.T T_ON -> () + | MenhirInterpreter.T T_OMITTED -> () + | MenhirInterpreter.T T_OK_BUTTON -> () + | MenhirInterpreter.T T_OFF -> () + | MenhirInterpreter.T T_OF -> () + | MenhirInterpreter.T T_OCCURS -> () + | MenhirInterpreter.T T_OBJECT_REFERENCE -> () + | MenhirInterpreter.T T_OBJECT_PROGRAM -> () + | MenhirInterpreter.T T_OBJECT_COMPUTER -> () + | MenhirInterpreter.T T_OBJECT -> () + | MenhirInterpreter.T T_NUM_ROWS -> () + | MenhirInterpreter.T T_NUM_COL_HEADINGS -> () + | MenhirInterpreter.T T_NUMERIC_EDITED -> () + | MenhirInterpreter.T T_NUMERIC -> () + | MenhirInterpreter.T T_NUMBERS -> () + | MenhirInterpreter.T T_NUMBER -> () + | MenhirInterpreter.T T_NULLS -> () + | MenhirInterpreter.T T_NULLIT -> "_" + | MenhirInterpreter.T T_NULL -> () + | MenhirInterpreter.T T_NO_UPDOWN -> () + | MenhirInterpreter.T T_NO_SEARCH -> () + | MenhirInterpreter.T T_NO_KEY_LETTER -> () + | MenhirInterpreter.T T_NO_GROUP_TAB -> () + | MenhirInterpreter.T T_NO_FOCUS -> () + | MenhirInterpreter.T T_NO_F4 -> () + | MenhirInterpreter.T T_NO_ECHO -> () + | MenhirInterpreter.T T_NO_DIVIDERS -> () + | MenhirInterpreter.T T_NO_DATA -> () + | MenhirInterpreter.T T_NO_BOX -> () + | MenhirInterpreter.T T_NO_AUTO_DEFAULT -> () + | MenhirInterpreter.T T_NO_AUTOSEL -> () + | MenhirInterpreter.T T_NOT_ON_SIZE_ERROR -> () + | MenhirInterpreter.T T_NOT_ON_OVERFLOW -> () + | MenhirInterpreter.T T_NOT_ON_EXCEPTION -> () + | MenhirInterpreter.T T_NOT_INVALID_KEY -> () + | MenhirInterpreter.T T_NOT_AT_EOP -> () + | MenhirInterpreter.T T_NOT_AT_END -> () + | MenhirInterpreter.T T_NOTIFY_SELCHANGE -> () + | MenhirInterpreter.T T_NOTIFY_DBLCLICK -> () + | MenhirInterpreter.T T_NOTIFY_CHANGE -> () + | MenhirInterpreter.T T_NOTIFY -> () + | MenhirInterpreter.T T_NOTHING -> () + | MenhirInterpreter.T T_NOTAB -> () + | MenhirInterpreter.T T_NOT -> () + | MenhirInterpreter.T T_NORMAL -> () + | MenhirInterpreter.T T_NONNUMERIC -> () + | MenhirInterpreter.T T_NONE -> () + | MenhirInterpreter.T T_NOMINAL -> () + | MenhirInterpreter.T T_NO -> () + | MenhirInterpreter.T T_NEXT_PAGE -> () + | MenhirInterpreter.T T_NEXT_ITEM -> () + | MenhirInterpreter.T T_NEXT -> () + | MenhirInterpreter.T T_NEW -> () + | MenhirInterpreter.T T_NESTED -> () + | MenhirInterpreter.T T_NEGATIVE -> () + | MenhirInterpreter.T T_NEAREST_TO_ZERO -> () + | MenhirInterpreter.T T_NEAREST_TOWARD_ZERO -> () + | MenhirInterpreter.T T_NEAREST_EVEN -> () + | MenhirInterpreter.T T_NEAREST_AWAY_FROM_ZERO -> () + | MenhirInterpreter.T T_NE -> () + | MenhirInterpreter.T T_NAVIGATE_URL -> () + | MenhirInterpreter.T T_NATLIT -> "_" + | MenhirInterpreter.T T_NATIVE -> () + | MenhirInterpreter.T T_NATIONAL_EDITED -> () + | MenhirInterpreter.T T_NATIONAL -> () + | MenhirInterpreter.T T_NAT -> () + | MenhirInterpreter.T T_NAMESPACE_PREFIX -> () + | MenhirInterpreter.T T_NAMESPACE -> () + | MenhirInterpreter.T T_NAMED -> () + | MenhirInterpreter.T T_NAME -> () + | MenhirInterpreter.T T_MULTIPLY -> () + | MenhirInterpreter.T T_MULTIPLE -> () + | MenhirInterpreter.T T_MULTILINE -> () + | MenhirInterpreter.T T_MOVE -> () + | MenhirInterpreter.T T_MODULES -> () + | MenhirInterpreter.T T_MODIFY -> () + | MenhirInterpreter.T T_MODE -> () + | MenhirInterpreter.T T_MIN_VAL -> () + | MenhirInterpreter.T T_MINUS -> () + | MenhirInterpreter.T T_MICROSECOND_TIME -> () + | MenhirInterpreter.T T_METHOD_ID -> () + | MenhirInterpreter.T T_METHOD -> () + | MenhirInterpreter.T T_MESSAGE_TAG -> () + | MenhirInterpreter.T T_MESSAGE -> () + | MenhirInterpreter.T T_MERGE -> () + | MenhirInterpreter.T T_MENU -> () + | MenhirInterpreter.T T_MEMORY -> () + | MenhirInterpreter.T T_MEDIUM_FONT -> () + | MenhirInterpreter.T T_MAX_VAL -> () + | MenhirInterpreter.T T_MAX_TEXT -> () + | MenhirInterpreter.T T_MAX_PROGRESS -> () + | MenhirInterpreter.T T_MAX_LINES -> () + | MenhirInterpreter.T T_MASTER_INDEX -> () + | MenhirInterpreter.T T_MASS_UPDATE -> () + | MenhirInterpreter.T T_MANUAL -> () + | MenhirInterpreter.T T_MAGNETIC_TAPE -> () + | MenhirInterpreter.T T_LT -> () + | MenhirInterpreter.T T_LPAR -> () + | MenhirInterpreter.T T_LOW_VALUE -> () + | MenhirInterpreter.T T_LOW_COLOR -> () + | MenhirInterpreter.T T_LOWLIGHT -> () + | MenhirInterpreter.T T_LOWERED -> () + | MenhirInterpreter.T T_LOWER -> () + | MenhirInterpreter.T T_LONG_DATE -> () + | MenhirInterpreter.T T_LOCK_HOLDING -> () + | MenhirInterpreter.T T_LOCKS -> () + | MenhirInterpreter.T T_LOCK -> () + | MenhirInterpreter.T T_LOCATION -> () + | MenhirInterpreter.T T_LOCAL_STORAGE -> () + | MenhirInterpreter.T T_LOCALE -> () + | MenhirInterpreter.T T_LOC -> () + | MenhirInterpreter.T T_LM_RESIZE -> () + | MenhirInterpreter.T T_LIST_BOX -> () + | MenhirInterpreter.T T_LINKAGE -> () + | MenhirInterpreter.T T_LINE_SEQUENTIAL -> () + | MenhirInterpreter.T T_LINE_COUNTER -> () + | MenhirInterpreter.T T_LINES_PER_PAGE -> () + | MenhirInterpreter.T T_LINES_AT_ROOT -> () + | MenhirInterpreter.T T_LINES -> () + | MenhirInterpreter.T T_LINE -> () + | MenhirInterpreter.T T_LINAGE_COUNTER -> () + | MenhirInterpreter.T T_LINAGE -> () + | MenhirInterpreter.T T_LIMITS -> () + | MenhirInterpreter.T T_LIMIT -> () + | MenhirInterpreter.T T_LIKE -> () + | MenhirInterpreter.T T_LIBRARY -> () + | MenhirInterpreter.T T_LESS -> () + | MenhirInterpreter.T T_LENGTH -> () + | MenhirInterpreter.T T_LEFT_TEXT -> () + | MenhirInterpreter.T T_LEFT_JUSTIFY -> () + | MenhirInterpreter.T T_LEFTLINE -> () + | MenhirInterpreter.T T_LEFT -> () + | MenhirInterpreter.T T_LEAVE -> () + | MenhirInterpreter.T T_LEADING_SHIFT -> () + | MenhirInterpreter.T T_LEADING -> () + | MenhirInterpreter.T T_LE -> () + | MenhirInterpreter.T T_LC_TIME -> () + | MenhirInterpreter.T T_LC_NUMERIC -> () + | MenhirInterpreter.T T_LC_MONETARY -> () + | MenhirInterpreter.T T_LC_MESSAGES -> () + | MenhirInterpreter.T T_LC_CTYPE -> () + | MenhirInterpreter.T T_LC_COLLATE -> () + | MenhirInterpreter.T T_LC_ALL -> () + | MenhirInterpreter.T T_LAYOUT_MANAGER -> () + | MenhirInterpreter.T T_LAYOUT_DATA -> () + | MenhirInterpreter.T T_LAST_ROW -> () + | MenhirInterpreter.T T_LAST -> () + | MenhirInterpreter.T T_LARGE_OFFSET -> () + | MenhirInterpreter.T T_LARGE_FONT -> () + | MenhirInterpreter.T T_LABEL_OFFSET -> () + | MenhirInterpreter.T T_LABEL -> () + | MenhirInterpreter.T T_KEY_LOCATION -> () + | MenhirInterpreter.T T_KEYED -> () + | MenhirInterpreter.T T_KEYBOARD -> () + | MenhirInterpreter.T T_KEY -> () + | MenhirInterpreter.T T_KEPT -> () + | MenhirInterpreter.T T_JUSTIFIED -> () + | MenhirInterpreter.T T_JSON -> () + | MenhirInterpreter.T T_I_O_CONTROL -> () + | MenhirInterpreter.T T_I_O -> () + | MenhirInterpreter.T T_ITEM_VALUE -> () + | MenhirInterpreter.T T_ITEM_TO_EMPTY -> () + | MenhirInterpreter.T T_ITEM_TO_DELETE -> () + | MenhirInterpreter.T T_ITEM_TO_ADD -> () + | MenhirInterpreter.T T_ITEM_TEXT -> () + | MenhirInterpreter.T T_ITEM -> () + | MenhirInterpreter.T T_IS_TYPEDEF -> () + | MenhirInterpreter.T T_IS_GLOBAL -> () + | MenhirInterpreter.T T_IS_EXTERNAL -> () + | MenhirInterpreter.T T_IS -> () + | MenhirInterpreter.T T_IN_ARITHMETIC_RANGE -> () + | MenhirInterpreter.T T_INVOKING -> () + | MenhirInterpreter.T T_INVOKE -> () + | MenhirInterpreter.T T_INVALID_KEY -> () + | MenhirInterpreter.T T_INVALID -> () + | MenhirInterpreter.T T_INTRINSIC -> () + | MenhirInterpreter.T T_INTO -> () + | MenhirInterpreter.T T_INTERVENING_ -> raise Not_found + | MenhirInterpreter.T T_INTERMEDIATE -> () + | MenhirInterpreter.T T_INTERFACE_ID -> () + | MenhirInterpreter.T T_INTERFACE -> () + | MenhirInterpreter.T T_INSTALLATION -> "_" + | MenhirInterpreter.T T_INSPECT -> () + | MenhirInterpreter.T T_INSERT_ROWS -> () + | MenhirInterpreter.T T_INSERTION_INDEX -> () + | MenhirInterpreter.T T_INQUIRE -> () + | MenhirInterpreter.T T_INPUT_OUTPUT -> () + | MenhirInterpreter.T T_INPUT -> () + | MenhirInterpreter.T T_INITIATE -> () + | MenhirInterpreter.T T_INITIALIZED -> () + | MenhirInterpreter.T T_INITIALIZE -> () + | MenhirInterpreter.T T_INITIAL -> () + | MenhirInterpreter.T T_INHERITS -> () + | MenhirInterpreter.T T_INDICATE -> () + | MenhirInterpreter.T T_INDEX_2 -> () + | MenhirInterpreter.T T_INDEX_1 -> () + | MenhirInterpreter.T T_INDEXED -> () + | MenhirInterpreter.T T_INDEX -> () + | MenhirInterpreter.T T_INDEPENDENT -> () + | MenhirInterpreter.T T_IN -> () + | MenhirInterpreter.T T_IMPLEMENTS -> () + | MenhirInterpreter.T T_IGNORING -> () + | MenhirInterpreter.T T_IGNORE -> () + | MenhirInterpreter.T T_IF -> () + | MenhirInterpreter.T T_IDS_II -> () + | MenhirInterpreter.T T_IDENTIFIED -> () + | MenhirInterpreter.T T_IDENTIFICATION -> () + | MenhirInterpreter.T T_ID -> () + | MenhirInterpreter.T T_ICON -> () + | MenhirInterpreter.T T_HSCROLL_POS -> () + | MenhirInterpreter.T T_HSCROLL -> () + | MenhirInterpreter.T T_HOT_TRACK -> () + | MenhirInterpreter.T T_HIGH_VALUE -> () + | MenhirInterpreter.T T_HIGH_ORDER_RIGHT -> () + | MenhirInterpreter.T T_HIGH_ORDER_LEFT -> () + | MenhirInterpreter.T T_HIGH_COLOR -> () + | MenhirInterpreter.T T_HIGHLIGHT -> () + | MenhirInterpreter.T T_HIDDEN_DATA -> () + | MenhirInterpreter.T T_HEXLIT -> "_" + | MenhirInterpreter.T T_HEX -> () + | MenhirInterpreter.T T_HEIGHT_IN_CELLS -> () + | MenhirInterpreter.T T_HEAVY -> () + | MenhirInterpreter.T T_HEADING_FONT -> () + | MenhirInterpreter.T T_HEADING_DIVIDER_COLOR -> () + | MenhirInterpreter.T T_HEADING_COLOR -> () + | MenhirInterpreter.T T_HEADING -> () + | MenhirInterpreter.T T_HAS_CHILDREN -> () + | MenhirInterpreter.T T_HANDLE -> () + | MenhirInterpreter.T T_GT -> () + | MenhirInterpreter.T T_GROUP_VALUE -> () + | MenhirInterpreter.T T_GROUP_USAGE -> () + | MenhirInterpreter.T T_GROUP -> () + | MenhirInterpreter.T T_GRID -> () + | MenhirInterpreter.T T_GREATER -> () + | MenhirInterpreter.T T_GRAPHICAL -> () + | MenhirInterpreter.T T_GO_SEARCH -> () + | MenhirInterpreter.T T_GO_HOME -> () + | MenhirInterpreter.T T_GO_FORWARD -> () + | MenhirInterpreter.T T_GO_BACK -> () + | MenhirInterpreter.T T_GOBACK -> () + | MenhirInterpreter.T T_GO -> () + | MenhirInterpreter.T T_GLOBAL -> () + | MenhirInterpreter.T T_GIVING -> () + | MenhirInterpreter.T T_GET -> () + | MenhirInterpreter.T T_GENERATE -> () + | MenhirInterpreter.T T_GE -> () + | MenhirInterpreter.T T_GCOS -> () + | MenhirInterpreter.T T_FUNCTION_POINTER -> () + | MenhirInterpreter.T T_FUNCTION_ID -> () + | MenhirInterpreter.T T_FUNCTION -> () + | MenhirInterpreter.T T_FULL_HEIGHT -> () + | MenhirInterpreter.T T_FULL -> () + | MenhirInterpreter.T T_FROM -> () + | MenhirInterpreter.T T_FREE -> () + | MenhirInterpreter.T T_FRAMED -> () + | MenhirInterpreter.T T_FRAME -> () + | MenhirInterpreter.T T_FORMAT -> () + | MenhirInterpreter.T T_FOREVER -> () + | MenhirInterpreter.T T_FOREGROUND_COLOR -> () + | MenhirInterpreter.T T_FOR -> () + | MenhirInterpreter.T T_FOOTING -> () + | MenhirInterpreter.T T_FONT -> () + | MenhirInterpreter.T T_FLR -> () + | MenhirInterpreter.T T_FLOAT_SHORT -> () + | MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_SIGNALING -> () + | MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER_QUIET -> () + | MenhirInterpreter.T T_FLOAT_NOT_A_NUMBER -> () + | MenhirInterpreter.T T_FLOAT_LONG -> () + | MenhirInterpreter.T T_FLOAT_INFINITY -> () + | MenhirInterpreter.T T_FLOAT_EXTENDED -> () + | MenhirInterpreter.T T_FLOAT_DECIMAL_34 -> () + | MenhirInterpreter.T T_FLOAT_DECIMAL_16 -> () + | MenhirInterpreter.T T_FLOAT_DECIMAL -> () + | MenhirInterpreter.T T_FLOAT_BINARY_64 -> () + | MenhirInterpreter.T T_FLOAT_BINARY_32 -> () + | MenhirInterpreter.T T_FLOAT_BINARY_128 -> () + | MenhirInterpreter.T T_FLOAT_BINARY -> () + | MenhirInterpreter.T T_FLOATLIT -> "0", '.', "0", "1" + | MenhirInterpreter.T T_FLOATING -> () + | MenhirInterpreter.T T_FLOAT -> () + | MenhirInterpreter.T T_FLAT_BUTTONS -> () + | MenhirInterpreter.T T_FLAT -> () + | MenhirInterpreter.T T_FIXED_WIDTH -> () + | MenhirInterpreter.T T_FIXED_FONT -> () + | MenhirInterpreter.T T_FIXEDLIT -> "0", '.', "0" + | MenhirInterpreter.T T_FIXED -> () + | MenhirInterpreter.T T_FIRST -> () + | MenhirInterpreter.T T_FINISH_REASON -> () + | MenhirInterpreter.T T_FINALLY -> () + | MenhirInterpreter.T T_FINAL -> () + | MenhirInterpreter.T T_FILL_PERCENT -> () + | MenhirInterpreter.T T_FILL_COLOR2 -> () + | MenhirInterpreter.T T_FILL_COLOR -> () + | MenhirInterpreter.T T_FILLER -> () + | MenhirInterpreter.T T_FILE_POS -> () + | MenhirInterpreter.T T_FILE_NAME -> () + | MenhirInterpreter.T T_FILE_LIMITS -> () + | MenhirInterpreter.T T_FILE_LIMIT -> () + | MenhirInterpreter.T T_FILE_ID -> () + | MenhirInterpreter.T T_FILE_CONTROL -> () + | MenhirInterpreter.T T_FILES -> () + | MenhirInterpreter.T T_FILE -> () + | MenhirInterpreter.T T_FH__KEYDEF -> () + | MenhirInterpreter.T T_FH__FCD -> () + | MenhirInterpreter.T T_FD -> () + | MenhirInterpreter.T T_FARTHEST_FROM_ZERO -> () + | MenhirInterpreter.T T_FALSE -> () + | MenhirInterpreter.T T_FACTORY -> () + | MenhirInterpreter.T T_F -> () + | MenhirInterpreter.T T_EXTERNAL_FORM -> () + | MenhirInterpreter.T T_EXTERNAL -> () + | MenhirInterpreter.T T_EXTERN -> () + | MenhirInterpreter.T T_EXTENDED_SEARCH -> () + | MenhirInterpreter.T T_EXTEND -> () + | MenhirInterpreter.T T_EXPANDS -> () + | MenhirInterpreter.T T_EXPAND -> () + | MenhirInterpreter.T T_EXIT -> () + | MenhirInterpreter.T T_EXHIBIT -> () + | MenhirInterpreter.T T_EXCLUSIVE_OR -> () + | MenhirInterpreter.T T_EXCLUSIVE -> () + | MenhirInterpreter.T T_EXCEPTION_VALUE -> () + | MenhirInterpreter.T T_EXCEPTION_OBJECT -> () + | MenhirInterpreter.T T_EXCEPTION -> () + | MenhirInterpreter.T T_EXAMINE -> () + | MenhirInterpreter.T T_EVERY -> () + | MenhirInterpreter.T T_EVENT_LIST -> () + | MenhirInterpreter.T T_EVENT -> () + | MenhirInterpreter.T T_EVALUATE -> () + | MenhirInterpreter.T T_ESI -> () + | MenhirInterpreter.T T_ESCAPE_BUTTON -> () + | MenhirInterpreter.T T_ESCAPE -> () + | MenhirInterpreter.T T_ERROR -> () + | MenhirInterpreter.T T_ERASE -> () + | MenhirInterpreter.T T_EQUAL -> () + | MenhirInterpreter.T T_EQ -> () + | MenhirInterpreter.T T_EOS -> () + | MenhirInterpreter.T T_EOP -> () + | MenhirInterpreter.T T_EOL -> () + | MenhirInterpreter.T T_EOF -> () + | MenhirInterpreter.T T_EO -> () + | MenhirInterpreter.T T_ENVIRONMENT_VALUE -> () + | MenhirInterpreter.T T_ENVIRONMENT_NAME -> () + | MenhirInterpreter.T T_ENVIRONMENT -> () + | MenhirInterpreter.T T_ENTRY_REASON -> () + | MenhirInterpreter.T T_ENTRY_FIELD -> () + | MenhirInterpreter.T T_ENTRY_CONVENTION -> () + | MenhirInterpreter.T T_ENTRY -> () + | MenhirInterpreter.T T_ENTER -> () + | MenhirInterpreter.T T_ENSURE_VISIBLE -> () + | MenhirInterpreter.T T_ENGRAVED -> () + | MenhirInterpreter.T T_END_XML -> () + | MenhirInterpreter.T T_END_WRITE -> () + | MenhirInterpreter.T T_END_UNSTRING -> () + | MenhirInterpreter.T T_END_SUBTRACT -> () + | MenhirInterpreter.T T_END_STRING -> () + | MenhirInterpreter.T T_END_START -> () + | MenhirInterpreter.T T_END_SEND -> () + | MenhirInterpreter.T T_END_SEARCH -> () + | MenhirInterpreter.T T_END_REWRITE -> () + | MenhirInterpreter.T T_END_RETURN -> () + | MenhirInterpreter.T T_END_RECEIVE -> () + | MenhirInterpreter.T T_END_READ -> () + | MenhirInterpreter.T T_END_PERFORM -> () + | MenhirInterpreter.T T_END_OF_PAGE -> () + | MenhirInterpreter.T T_END_MULTIPLY -> () + | MenhirInterpreter.T T_END_MODIFY -> () + | MenhirInterpreter.T T_END_JSON -> () + | MenhirInterpreter.T T_END_IF -> () + | MenhirInterpreter.T T_END_EVALUATE -> () + | MenhirInterpreter.T T_END_DIVIDE -> () + | MenhirInterpreter.T T_END_DISPLAY -> () + | MenhirInterpreter.T T_END_DELETE -> () + | MenhirInterpreter.T T_END_COMPUTE -> () + | MenhirInterpreter.T T_END_COLOR -> () + | MenhirInterpreter.T T_END_CHAIN -> () + | MenhirInterpreter.T T_END_CALL -> () + | MenhirInterpreter.T T_END_ADD -> () + | MenhirInterpreter.T T_END_ACCEPT -> () + | MenhirInterpreter.T T_ENDING -> () + | MenhirInterpreter.T T_END -> () + | MenhirInterpreter.T T_ENCRYPTION -> () + | MenhirInterpreter.T T_ENCODING -> () + | MenhirInterpreter.T T_ENABLE -> () + | MenhirInterpreter.T T_EMI -> () + | MenhirInterpreter.T T_ELSE -> () + | MenhirInterpreter.T T_ELEMENT -> () + | MenhirInterpreter.T T_EIGHTY_EIGHT -> () + | MenhirInterpreter.T T_EGI -> () + | MenhirInterpreter.T T_EDITING -> () + | MenhirInterpreter.T T_ECHO -> () + | MenhirInterpreter.T T_EC -> () + | MenhirInterpreter.T T_EBCDIC -> () + | MenhirInterpreter.T T_DYNAMIC -> () + | MenhirInterpreter.T T_DUPLICATES -> () + | MenhirInterpreter.T T_DROP_LIST -> () + | MenhirInterpreter.T T_DROP_DOWN -> () + | MenhirInterpreter.T T_DRAG_COLOR -> () + | MenhirInterpreter.T T_DOWN -> () + | MenhirInterpreter.T T_DOUBLE_COLON -> () + | MenhirInterpreter.T T_DOUBLE_ASTERISK -> () + | MenhirInterpreter.T T_DOUBLE -> () + | MenhirInterpreter.T T_DOTTED -> () + | MenhirInterpreter.T T_DOTDASH -> () + | MenhirInterpreter.T T_DIVISION -> () + | MenhirInterpreter.T T_DIVIDER_COLOR -> () + | MenhirInterpreter.T T_DIVIDERS -> () + | MenhirInterpreter.T T_DIVIDE -> () + | MenhirInterpreter.T T_DISPLAY_FORMAT -> () + | MenhirInterpreter.T T_DISPLAY_COLUMNS -> () + | MenhirInterpreter.T T_DISPLAY_4 -> () + | MenhirInterpreter.T T_DISPLAY_3 -> () + | MenhirInterpreter.T T_DISPLAY_2 -> () + | MenhirInterpreter.T T_DISPLAY_1 -> () + | MenhirInterpreter.T T_DISPLAY -> () + | MenhirInterpreter.T T_DISP -> () + | MenhirInterpreter.T T_DISK -> () + | MenhirInterpreter.T T_DISCONNECT -> () + | MenhirInterpreter.T T_DISC -> () + | MenhirInterpreter.T T_DISABLE -> () + | MenhirInterpreter.T T_DIGITS -> "0" + | MenhirInterpreter.T T_DETAIL -> () + | MenhirInterpreter.T T_DESTROY -> () + | MenhirInterpreter.T T_DESTINATION -> () + | MenhirInterpreter.T T_DESCENDING -> () + | MenhirInterpreter.T T_DEPENDING -> () + | MenhirInterpreter.T T_DELIMITER -> () + | MenhirInterpreter.T T_DELIMITED -> () + | MenhirInterpreter.T T_DELETE -> () + | MenhirInterpreter.T T_DEFINITION -> () + | MenhirInterpreter.T T_DEFAULT_FONT -> () + | MenhirInterpreter.T T_DEFAULT_BUTTON -> () + | MenhirInterpreter.T T_DEFAULT -> () + | MenhirInterpreter.T T_DECLARATIVES -> () + | MenhirInterpreter.T T_DECIMAL_POINT -> () + | MenhirInterpreter.T T_DECIMAL_ENCODING -> () + | MenhirInterpreter.T T_DEBUG_SUB_3 -> () + | MenhirInterpreter.T T_DEBUG_SUB_2 -> () + | MenhirInterpreter.T T_DEBUG_SUB_1 -> () + | MenhirInterpreter.T T_DEBUG_NAME -> () + | MenhirInterpreter.T T_DEBUG_LINE -> () + | MenhirInterpreter.T T_DEBUG_ITEM -> () + | MenhirInterpreter.T T_DEBUG_CONTENTS -> () + | MenhirInterpreter.T T_DEBUGGING -> () + | MenhirInterpreter.T T_DAY_OF_WEEK -> () + | MenhirInterpreter.T T_DAY -> () + | MenhirInterpreter.T T_DATE_WRITTEN -> "_" + | MenhirInterpreter.T T_DATE_MODIFIED -> "_" + | MenhirInterpreter.T T_DATE_ENTRY -> () + | MenhirInterpreter.T T_DATE_COMPILED -> "_" + | MenhirInterpreter.T T_DATE -> () + | MenhirInterpreter.T T_DATA_TYPES -> () + | MenhirInterpreter.T T_DATA_RECORDS -> () + | MenhirInterpreter.T T_DATA_RECORD -> () + | MenhirInterpreter.T T_DATA_POINTER -> () + | MenhirInterpreter.T T_DATA_COLUMNS -> () + | MenhirInterpreter.T T_DATA -> () + | MenhirInterpreter.T T_DASH_SIGN -> () + | MenhirInterpreter.T T_DASHED -> () + | MenhirInterpreter.T T_CYL_OVERFLOW -> () + | MenhirInterpreter.T T_CYL_INDEX -> () + | MenhirInterpreter.T T_CYCLE -> () + | MenhirInterpreter.T T_CUSTOM_PRINT_TEMPLATE -> () + | MenhirInterpreter.T T_CURSOR_Y -> () + | MenhirInterpreter.T T_CURSOR_X -> () + | MenhirInterpreter.T T_CURSOR_ROW -> () + | MenhirInterpreter.T T_CURSOR_FRAME_WIDTH -> () + | MenhirInterpreter.T T_CURSOR_COLOR -> () + | MenhirInterpreter.T T_CURSOR_COL -> () + | MenhirInterpreter.T T_CURSOR -> () + | MenhirInterpreter.T T_CURRENT -> () + | MenhirInterpreter.T T_CURRENCY -> () + | MenhirInterpreter.T T_CS_GENERAL -> () + | MenhirInterpreter.T T_CS_BASIC -> () + | MenhirInterpreter.T T_CSIZE -> () + | MenhirInterpreter.T T_CRT_UNDER -> () + | MenhirInterpreter.T T_CRT -> () + | MenhirInterpreter.T T_COUNT -> () + | MenhirInterpreter.T T_CORRESPONDING -> () + | MenhirInterpreter.T T_CORE_INDEX -> () + | MenhirInterpreter.T T_COPY_SELECTION -> () + | MenhirInterpreter.T T_COPY -> () + | MenhirInterpreter.T T_CONVERTING -> () + | MenhirInterpreter.T T_CONVERSION -> () + | MenhirInterpreter.T T_CONTROLS -> () + | MenhirInterpreter.T T_CONTROL -> () + | MenhirInterpreter.T T_CONTINUE -> () + | MenhirInterpreter.T T_CONTENT -> () + | MenhirInterpreter.T T_CONTAINS -> () + | MenhirInterpreter.T T_CONSTANT -> () + | MenhirInterpreter.T T_CONSOLE_3 -> () + | MenhirInterpreter.T T_CONSOLE_2 -> () + | MenhirInterpreter.T T_CONSOLE_1 -> () + | MenhirInterpreter.T T_CONSOLE_0 -> () + | MenhirInterpreter.T T_CONNECT -> () + | MenhirInterpreter.T T_CONFIGURATION -> () + | MenhirInterpreter.T T_CONDITION -> () + | MenhirInterpreter.T T_COMP_X -> () + | MenhirInterpreter.T T_COMP_N -> () + | MenhirInterpreter.T T_COMP_9 -> () + | MenhirInterpreter.T T_COMP_7 -> () + | MenhirInterpreter.T T_COMP_6 -> () + | MenhirInterpreter.T T_COMP_5 -> () + | MenhirInterpreter.T T_COMP_4 -> () + | MenhirInterpreter.T T_COMP_3 -> () + | MenhirInterpreter.T T_COMP_2 -> () + | MenhirInterpreter.T T_COMP_15 -> () + | MenhirInterpreter.T T_COMP_14 -> () + | MenhirInterpreter.T T_COMP_13 -> () + | MenhirInterpreter.T T_COMP_12 -> () + | MenhirInterpreter.T T_COMP_11 -> () + | MenhirInterpreter.T T_COMP_10 -> () + | MenhirInterpreter.T T_COMP_1 -> () + | MenhirInterpreter.T T_COMP_0 -> () + | MenhirInterpreter.T T_COMPUTE -> () + | MenhirInterpreter.T T_COMPUTATIONAL_7 -> () + | MenhirInterpreter.T T_COMPUTATIONAL_14 -> () + | MenhirInterpreter.T T_COMPUTATIONAL_13 -> () + | MenhirInterpreter.T T_COMPUTATIONAL_12 -> () + | MenhirInterpreter.T T_COMPUTATIONAL_11 -> () + | MenhirInterpreter.T T_COMPLEMENTARY -> () + | MenhirInterpreter.T T_COMPLE -> () + | MenhirInterpreter.T T_COMP -> () + | MenhirInterpreter.T T_COMMUNICATION -> () + | MenhirInterpreter.T T_COMMON -> () + | MenhirInterpreter.T T_COMMIT -> () + | MenhirInterpreter.T T_COMMAND_LINE -> () + | MenhirInterpreter.T T_COMMA -> () + | MenhirInterpreter.T T_COMBO_BOX -> () + | MenhirInterpreter.T T_COLUMN_PROTECTION -> () + | MenhirInterpreter.T T_COLUMN_HEADINGS -> () + | MenhirInterpreter.T T_COLUMN_FONT -> () + | MenhirInterpreter.T T_COLUMN_DIVIDERS -> () + | MenhirInterpreter.T T_COLUMN_COLOR -> () + | MenhirInterpreter.T T_COLUMNS -> () + | MenhirInterpreter.T T_COLUMN -> () + | MenhirInterpreter.T T_COLORS -> () + | MenhirInterpreter.T T_COLOR -> () + | MenhirInterpreter.T T_COLON -> () + | MenhirInterpreter.T T_COLLATING -> () + | MenhirInterpreter.T T_COL -> () + | MenhirInterpreter.T T_CODE_SET -> () + | MenhirInterpreter.T T_CODE -> () + | MenhirInterpreter.T T_COBOL -> () + | MenhirInterpreter.T T_CLOSE -> () + | MenhirInterpreter.T T_CLOCK_UNITS -> () + | MenhirInterpreter.T T_CLINES -> () + | MenhirInterpreter.T T_CLINE -> () + | MenhirInterpreter.T T_CLEAR_SELECTION -> () + | MenhirInterpreter.T T_CLASS_ID -> () + | MenhirInterpreter.T T_CLASSIFICATION -> () + | MenhirInterpreter.T T_CLASS -> () + | MenhirInterpreter.T T_CHECK_BOX -> () + | MenhirInterpreter.T T_CHECKPOINT_FILE -> () + | MenhirInterpreter.T T_CHECK -> () + | MenhirInterpreter.T T_CHARACTERS -> () + | MenhirInterpreter.T T_CHARACTER -> () + | MenhirInterpreter.T T_CHANGED -> () + | MenhirInterpreter.T T_CHAINING -> () + | MenhirInterpreter.T T_CHAIN -> () + | MenhirInterpreter.T T_CH -> () + | MenhirInterpreter.T T_CF -> () + | MenhirInterpreter.T T_CENTURY_DATE -> () + | MenhirInterpreter.T T_CENTERED_HEADINGS -> () + | MenhirInterpreter.T T_CENTERED -> () + | MenhirInterpreter.T T_CENTER -> () + | MenhirInterpreter.T T_CELL_PROTECTION -> () + | MenhirInterpreter.T T_CELL_FONT -> () + | MenhirInterpreter.T T_CELL_DATA -> () + | MenhirInterpreter.T T_CELL_COLOR -> () + | MenhirInterpreter.T T_CELL -> () + | MenhirInterpreter.T T_CD -> () + | MenhirInterpreter.T T_CCOL -> () + | MenhirInterpreter.T T_CATALOGUE_NAME -> () + | MenhirInterpreter.T T_CATALOGUED -> () + | MenhirInterpreter.T T_CASSETTE -> () + | MenhirInterpreter.T T_CARD_READER -> () + | MenhirInterpreter.T T_CARD_PUNCH -> () + | MenhirInterpreter.T T_CAPACITY -> () + | MenhirInterpreter.T T_CANCEL_BUTTON -> () + | MenhirInterpreter.T T_CANCEL -> () + | MenhirInterpreter.T T_CALL -> () + | MenhirInterpreter.T T_CALENDAR_FONT -> () + | MenhirInterpreter.T T_C -> () + | MenhirInterpreter.T T_B_XOR -> () + | MenhirInterpreter.T T_B_SHIFT_RC -> () + | MenhirInterpreter.T T_B_SHIFT_R -> () + | MenhirInterpreter.T T_B_SHIFT_LC -> () + | MenhirInterpreter.T T_B_SHIFT_L -> () + | MenhirInterpreter.T T_B_OR -> () + | MenhirInterpreter.T T_B_NOT -> () + | MenhirInterpreter.T T_B_EXOR -> () + | MenhirInterpreter.T T_B_AND -> () + | MenhirInterpreter.T T_BYTE_LENGTH -> () + | MenhirInterpreter.T T_BYTES -> () + | MenhirInterpreter.T T_BYTE -> () + | MenhirInterpreter.T T_BY -> () + | MenhirInterpreter.T T_BUTTONS -> () + | MenhirInterpreter.T T_BUSY -> () + | MenhirInterpreter.T T_BULK_ADDITION -> () + | MenhirInterpreter.T T_BSN -> () + | MenhirInterpreter.T T_BOXED -> () + | MenhirInterpreter.T T_BOX -> () + | MenhirInterpreter.T T_BOTTOM -> () + | MenhirInterpreter.T T_BOOLIT -> boolean_zero + | MenhirInterpreter.T T_BOOLEAN -> () + | MenhirInterpreter.T T_BLOCK -> () + | MenhirInterpreter.T T_BLINK -> () + | MenhirInterpreter.T T_BLANK -> () + | MenhirInterpreter.T T_BITS -> () + | MenhirInterpreter.T T_BITMAP_WIDTH -> () + | MenhirInterpreter.T T_BITMAP_TRANSPARENT_COLOR -> () + | MenhirInterpreter.T T_BITMAP_TRAILING -> () + | MenhirInterpreter.T T_BITMAP_TIMER -> () + | MenhirInterpreter.T T_BITMAP_START -> () + | MenhirInterpreter.T T_BITMAP_NUMBER -> () + | MenhirInterpreter.T T_BITMAP_HANDLE -> () + | MenhirInterpreter.T T_BITMAP_END -> () + | MenhirInterpreter.T T_BITMAP -> () + | MenhirInterpreter.T T_BIT -> () + | MenhirInterpreter.T T_BINARY_SHORT -> () + | MenhirInterpreter.T T_BINARY_SEQUENTIAL -> () + | MenhirInterpreter.T T_BINARY_LONG -> () + | MenhirInterpreter.T T_BINARY_ENCODING -> () + | MenhirInterpreter.T T_BINARY_DOUBLE -> () + | MenhirInterpreter.T T_BINARY_C_LONG -> () + | MenhirInterpreter.T T_BINARY_CHAR -> () + | MenhirInterpreter.T T_BINARY -> () + | MenhirInterpreter.T T_BELL -> () + | MenhirInterpreter.T T_BEGINNING -> () + | MenhirInterpreter.T T_BEFORE -> () + | MenhirInterpreter.T T_BECOMES -> () + | MenhirInterpreter.T T_BASED -> () + | MenhirInterpreter.T T_BAR -> () + | MenhirInterpreter.T T_BACKWARD -> () + | MenhirInterpreter.T T_BACKGROUND_STANDARD -> () + | MenhirInterpreter.T T_BACKGROUND_LOW -> () + | MenhirInterpreter.T T_BACKGROUND_HIGH -> () + | MenhirInterpreter.T T_BACKGROUND_COLOR -> () + | MenhirInterpreter.T T_AWAY_FROM_ZERO -> () + | MenhirInterpreter.T T_AUTO_SPIN -> () + | MenhirInterpreter.T T_AUTO_DECIMAL -> () + | MenhirInterpreter.T T_AUTOMATIC -> () + | MenhirInterpreter.T T_AUTO -> () + | MenhirInterpreter.T T_AUTHOR -> "_" + | MenhirInterpreter.T T_AT_EOP -> () + | MenhirInterpreter.T T_AT_END -> () + | MenhirInterpreter.T T_ATTRIBUTES -> () + | MenhirInterpreter.T T_ATTRIBUTE -> () + | MenhirInterpreter.T T_AT -> () + | MenhirInterpreter.T T_ASTERISK -> () + | MenhirInterpreter.T T_ASSIGN -> () + | MenhirInterpreter.T T_ASCII -> () + | MenhirInterpreter.T T_ASCENDING -> () + | MenhirInterpreter.T T_ASA -> () + | MenhirInterpreter.T T_AS -> () + | MenhirInterpreter.T T_ARITHMETIC -> () + | MenhirInterpreter.T T_ARGUMENT_VALUE -> () + | MenhirInterpreter.T T_ARGUMENT_NUMBER -> () + | MenhirInterpreter.T T_AREAS -> () + | MenhirInterpreter.T T_AREA -> () + | MenhirInterpreter.T T_ARE -> () + | MenhirInterpreter.T T_APPLY -> () + | MenhirInterpreter.T T_ANYCASE -> () + | MenhirInterpreter.T T_ANY -> () + | MenhirInterpreter.T T_ANUM -> () + | MenhirInterpreter.T T_ANSI -> () + | MenhirInterpreter.T T_AND -> () + | MenhirInterpreter.T T_AMPERSAND -> () + | MenhirInterpreter.T T_ALTERNATE -> () + | MenhirInterpreter.T T_ALTERING -> () + | MenhirInterpreter.T T_ALTER -> () + | MenhirInterpreter.T T_ALSO -> () + | MenhirInterpreter.T T_ALPHANUM_PREFIX -> ("_", Quote) + | MenhirInterpreter.T T_ALPHANUMERIC_EDITED -> () + | MenhirInterpreter.T T_ALPHANUMERIC -> () + | MenhirInterpreter.T T_ALPHANUM -> ("_", Quote) + | MenhirInterpreter.T T_ALPHABETIC_UPPER -> () + | MenhirInterpreter.T T_ALPHABETIC_LOWER -> () + | MenhirInterpreter.T T_ALPHABETIC -> () + | MenhirInterpreter.T T_ALPHABET -> () + | MenhirInterpreter.T T_ALLOWING -> () + | MenhirInterpreter.T T_ALLOCATE -> () + | MenhirInterpreter.T T_ALL -> () + | MenhirInterpreter.T T_ALIGNMENT -> () + | MenhirInterpreter.T T_ALIGNED -> () + | MenhirInterpreter.T T_ALIAS -> () + | MenhirInterpreter.T T_AFTER -> () + | MenhirInterpreter.T T_ADVANCING -> () + | MenhirInterpreter.T T_ADJUSTABLE_COLUMNS -> () + | MenhirInterpreter.T T_ADDRESS -> () + | MenhirInterpreter.T T_ADD -> () + | MenhirInterpreter.T T_ACTUAL -> () + | MenhirInterpreter.T T_ACTIVE_X -> () + | MenhirInterpreter.T T_ACTIVE_CLASS -> () + | MenhirInterpreter.T T_ACTIVATING -> () + | MenhirInterpreter.T T_ACTION -> () + | MenhirInterpreter.T T_ACCESS -> () + | MenhirInterpreter.T T_ACCEPT -> () + | MenhirInterpreter.T T_ABSENT -> () + | MenhirInterpreter.N MenhirInterpreter.N_write_target -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_write_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_working_storage_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_word_or_terminal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_with_test -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_with_status -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_with_no_advancing -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_with_lock_clause -> WithLockNone + | MenhirInterpreter.N MenhirInterpreter.N_with_lock -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_with_key -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_with_data -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_when_selection_objects -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_when_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_when_other -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_when_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_varying_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_varying_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_value_of_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_validation_stage -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_validation_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_validate_status_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_validate_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_using_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_using_by -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_use_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_use_after_exception -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_usage_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_usage -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_upon -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_up_down -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_unstring_target -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_unstring_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_unstring_delimiters -> [] + | MenhirInterpreter.N MenhirInterpreter.N_unlock_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_unconditional_action -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_typedef_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_transform_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_then_replacing -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_terminate_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_tallying_for -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_tallying -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_synchronized_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_symbolic_characters_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_suppress_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sum_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sum_operands -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sum_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_subtract_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_subscripts -> [] + | MenhirInterpreter.N MenhirInterpreter.N_subscript_following -> SubSAll + | MenhirInterpreter.N MenhirInterpreter.N_subscript_first -> SubSAll + | MenhirInterpreter.N MenhirInterpreter.N_structure_kind -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_string_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_string_or_int_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_string_literal_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_string_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_stop_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_stop_kind -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_step_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_status_switch -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_start_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_standalone_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_specifier -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_special_names_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_special_names_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_source_string -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_source_operands -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_source_destination_clauses -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_source_destination_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_source_computer_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_source_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sort_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sort_merge_file_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_signedness_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sign_condition_no_zero -> SgnPositive + | MenhirInterpreter.N MenhirInterpreter.N_sign_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sign_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sign -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sharing_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sharing_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sharing_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_set_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_set_attribute_switches -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_sentence -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_send_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_selection_subjects -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_selection_subject -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_selection_objects -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_selection_object -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_select_when_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_select_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_select -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_segment_limit_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_section_paragraphs -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_section_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_search_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_search_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_occurs_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_line_column_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_line_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_column_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_on_off -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_name -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_clauses -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_screen_attribute_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_same_as_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_same_area_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_s_delimited_by -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rounding_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rounded_phrase_opt -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rounded_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rounded_ident -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rounded_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ro_working_storage_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_with_test_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_with_status_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_step_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_special_names_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_source_computer_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_signedness_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_sign_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_sharing_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_screen_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_s_delimited_by_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_returning_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_retry_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_repository_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_report_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_read_direction_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_raising_exception_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_procedure_division_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_picture_locale_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_option_TO__name__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_86_qualname__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_44_property_kind__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_43_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_38_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_37_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_34_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_33_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_32_qualname_or_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_30_qualname_or_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_14_string_literal__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_101_ident__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf___anonymous_100_ident__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_VARYING_ident__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_USING_name__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_TO_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_string_or_int_literal__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_qualified_procedure_name__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_THROUGH_procedure_name__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_REMAINDER_ident__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_POSITION_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_ON_name__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_INTO_loc_ident___ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_INTO_ident__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_IN_name__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_integer__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_ident_or_literal__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_FROM_expression__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_BY_ident_or_numeric__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_BY_expression__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_pf_AS_string_literal__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_perform_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_options_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_object_reference_kind_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_object_procedure_division_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_object_computer_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_name_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_lock_or_retry_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_locale_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_local_storage_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_upon__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_program_procedure_division__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_procedure_division__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_environment_division__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_entry_name_clause__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_loc_data_division__ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_linkage_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_io_control_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_integer_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_instance_definition_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_input_output_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_identification_division_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_file_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_file_control_paragraph_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_expression_no_all_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_expands_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_endianness_mode_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_depending_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_configuration_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_communication_section_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_collating_sequence_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_close_format_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_capacity_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_ro_advancing_phrase_ -> None + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev_tallying_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_91_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_90_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_89_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnell_rev___anonymous_88_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_when_selection_objects_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_validation_stage_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_use_after_exception_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_unstring_target_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_subscript_following_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_specifier_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_screen_attribute_on_off_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_rounded_ident_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_qualname_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_qualified_procedure_name_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_pf_ALSO_string_or_int_literal__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_open_phrase_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_on_key_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_name_or_alphanum_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_name_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_using_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_using_by__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_tallying_for__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_special_names_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_sentence__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_select_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_section_paragraph__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_replacing_phrase__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_options_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_loc_decl_section_paragraph__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_through_literal_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_phrase_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_literal_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_line_position_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_integer_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_string_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_numeric_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_or_literal_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_by_after_before_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_ident_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_file_with_opt_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_debug_target_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_column_position_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rnel_argument_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_select_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_pf_FILE_name__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_name_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_result_imperative_statement__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_sort_merge_file_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_sentence__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_section_paragraph__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_screen_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_same_area_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_rerun_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_group_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_descr_entry__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_report_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_object_computer_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_multiple_file_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_method_definition__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_file_or_sort_merge_descr_entry__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_file_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_entry_name_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_data_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_screen_descr_entry__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_report_group_descr_entry__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_constant_or_data_descr_entry__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_communication_descr_entry__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_loc_communication_descr_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_key_is_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rl_inspect_where_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_rewrite_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_reversed_or_no_rewind_opt -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_returning -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_return_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_retry_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_resume_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_reserve_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rerun_frequency -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_rerun_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_repository_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_value_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_type_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_screen_usage_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_occurs_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_line_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_group_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_group_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_data_name_or_final -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_column_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_report_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_replacing_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_relop -> Eq + | MenhirInterpreter.N MenhirInterpreter.N_release_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_relative_key_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_relation_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_redefines_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_record_key_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_record_delimiter_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_record_delimiter -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_record_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_receive_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_read_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_read_direction -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_range_expression -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_raising_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_raising_exception -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_raise_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualnames -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualname_or_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualname_or_integer -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualname_or_alphanum -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualname -> dummy_qualname + | MenhirInterpreter.N MenhirInterpreter.N_qualified_procedure_name -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualident_refmod -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualident_no_refmod -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_qualident -> dummy_qualident + | MenhirInterpreter.N MenhirInterpreter.N_purge_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_property_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_prototype_id_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_prototype -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_procedure_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_kind -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_id_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_definition_no_end -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_definition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_program_collating_sequence_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_procedure_name_decl -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_procedure_name -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_procedure_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_present_when_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_position -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_plus_or_minus -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_picture_locale_phrase -> { locale_name = None; locale_size = "0" } + | MenhirInterpreter.N MenhirInterpreter.N_picture_clause -> dummy_picture + | MenhirInterpreter.N MenhirInterpreter.N_perform_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_perform_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_partial_expression -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_page_line_col -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_page_limit_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_padding_character_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_output_or_giving -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_organization_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_organization -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_order_table_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_options_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_options_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_optional_arguments_list -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_working_storage_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_with_test_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_with_status_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_step_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_special_names_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_source_computer_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_signedness_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_sign_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_sharing_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_screen_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_s_delimited_by_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_returning_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_retry_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_repository_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_report_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_read_direction_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_raising_exception_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_procedure_division_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_picture_locale_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_option_TO__name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_option_IS__name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_86_qualname__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_44_property_kind__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_43_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_38_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_37_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_34_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_33_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_32_qualname_or_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_30_qualname_or_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_14_string_literal__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_101_ident__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf___anonymous_100_ident__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_VARYING_ident__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_USING_name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_TO_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_string_or_int_literal__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_qualified_procedure_name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_THROUGH_procedure_name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_REMAINDER_ident__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_POSITION_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_ON_name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_INTO_loc_ident___ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_INTO_ident__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_IN_name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_integer__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_ident_or_literal__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_FROM_expression__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_BY_ident_or_numeric__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_BY_expression__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_pf_AS_string_literal__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_perform_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_or__NUMBER_NUMBERS__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_or__LINE_LINES__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_or__IS_ARE__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_or__AREA_AREAS__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_options_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_object_reference_kind_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_object_procedure_division_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_object_computer_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_name_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_mr___anonymous_0__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_lock_or_retry_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_locale_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_local_storage_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_upon__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_program_procedure_division__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_program_definition_no_end__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_procedure_division__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_environment_division__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_entry_name_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_data_division__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_SECURITY__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_INSTALLATION__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_DATE_WRITTEN__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_DATE_COMPILED__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_loc_AUTHOR__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_linkage_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_limit_is__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_io_control_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_io_control_entry_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_integer_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_instance_definition_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_input_output_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_identification_division_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_file_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_file_control_paragraph_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_expression_no_all_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_expands_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_endianness_mode_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_depending_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_default_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_default_display_clause_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_default_accept_clause_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_control_division_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_configuration_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_communication_section_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_collating_sequence_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_close_format_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_capacity_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_call_using_by_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_advancing_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option__assign_external__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_78_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_74_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_73_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_59_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_57_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_39_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_25_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_24_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_22_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option___anonymous_1_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_WITH_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_WHEN_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_TO_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_TIMES_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_THEN_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_THAN_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_TERMINAL_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_TAPE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_SYMBOLIC_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_STRUCTURE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_STATUS_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_SIZE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_SIGN_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_SET_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_RIGHT_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_REFERENCES_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_RECORD_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_PROGRAM_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_PROCEDURE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_PRINTING_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_PERIOD_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_OTHER_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_ORDER_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_ON_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_OF_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_NUMBER_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_MODE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_MESSAGE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_LINES_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_LINE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_LENGTH_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_LEFT_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_KEY_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_IS_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_INITIAL_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_INDICATE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_IN_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_FROM_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_FOR_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_FILE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_EVERY_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_END_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_DEFAULT_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_DATA_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_CONTAINS_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_COLLATING_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_CHARACTERS_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_CHARACTER_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_BY_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_AT_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_AREA_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_ARE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_option_ADVANCING_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_open_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_open_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_open_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_on_overflow -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_on_or_off -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_on_key -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_on_exception -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_occurs_fixed_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_occurs_dynamic_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_occurs_depending_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_view -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_reference_kind -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_ref -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_procedure_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_computer_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_object_computer_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_numeric_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ntl_name_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_ntl_arithmetic_term_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nonrel_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nonnumeric_literal_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nonnumeric_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_next_group_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_when_phrase_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_source_string_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_name_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_loc_result_imperative_statement__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev_loc_when_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nell_rev___anonymous_70_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_nel_when_selection_objects_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_validation_stage_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_use_after_exception_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_unstring_target_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_sum_phrase_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_subscript_following_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_specifier_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_screen_attribute_on_off_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_rounded_ident_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_qualname_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_qualified_procedure_name_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_pf_ALSO_string_or_int_literal__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_open_phrase_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_on_key_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_name_or_alphanum_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_name_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_using_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_using_by__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_tallying_for__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_special_names_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_source_destination_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_sentence__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_select_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_section_paragraph__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_screen_attribute_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_replacing_phrase__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_options_clause__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc_decl_section_paragraph__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_loc___anonymous_72__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_literal_through_literal_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_literal_phrase_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_literal_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_line_position_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_integer_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_string_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_numeric_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_or_literal_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_by_after_before_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_ident_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_file_with_opt_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_debug_target_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_column_position_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel_argument_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_84_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_80_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_50_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_48_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_42_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_29_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_21_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_16_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_nel___anonymous_13_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_names_or_open_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_names -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_name_or_string -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_name_or_alphanum -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_name -> dummy_name + | MenhirInterpreter.N MenhirInterpreter.N_multiply_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_multiple_file_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_move_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_mnemonic_name_suffix -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_mnemonic_name_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_85_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_77_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_on_overflow_NOT_ON_OVERFLOW__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_on_exception_NOT_ON_EXCEPTION__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_at_eop_NOT_AT_EOP__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_at_end_NOT_AT_END__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_ON_SIZE_ERROR_NOT_ON_SIZE_ERROR__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_76_INVALID_KEY_NOT_INVALID_KEY__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_68_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_67_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_66_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_65_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_64_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_62_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_61_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_58_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_55_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_54_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_53_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_52_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_51_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_40_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_35_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_28_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_27_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_15_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_midrule___anonymous_0_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_method_id_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_method_definition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_message_or_segment -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_merge_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_memory_size_unit -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_memory_size_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_mcs_kind -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_mcs_command -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_sf_rnel_loc_options_clause___PERIOD__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_26_nel_name___ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_20_names__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf___anonymous_17_names__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf_USING_rnel_loc_using_by____ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf_UPON_names__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_pf_ON_rnel_validation_stage___ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_indexed_by_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption_declaratives_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_9_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_8_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_7_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_6_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_5_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_49_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_loption___anonymous_4_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_lock_or_retry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_lock_mode_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_lock_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_locale_value_or_ident -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_locale_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_locale_or_default -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_locale_or_ambiguous -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_locale_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_locale_category -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_local_storage_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ll_rev_loc_compilation_unit__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ll_rev_and_clause_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_literal_through_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_literal_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_literal_int_ident -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_literal -> Integer "0" + | MenhirInterpreter.N MenhirInterpreter.N_list_select_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_pf_FILE_name__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_name_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_result_imperative_statement__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_sort_merge_file_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_sentence__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_section_paragraph__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_screen_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_same_area_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_rerun_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_group_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_descr_entry__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_report_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_program_definition__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_object_computer_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_multiple_file_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_method_definition__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_file_or_sort_merge_descr_entry__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_file_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_entry_name_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_data_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_screen_descr_entry__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_report_group_descr_entry__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_constant_or_data_descr_entry__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_communication_descr_entry__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_loc_communication_descr_clause__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_key_is_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_list_inspect_where_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_linkage_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_line_position -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_line_number -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_line_header -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_linage_header -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_linage_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_lc_all_or_default -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_label_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_l_pf_AFTER_loc_varying_phrase___ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_l_loc___anonymous_79__ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_l___anonymous_99_ -> [] + | MenhirInterpreter.N MenhirInterpreter.N_key_is -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_justified_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_io_control_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_io_control_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_invoke_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_invalid_when_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_intrinsic_function_name -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_intermediate_rounding_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_interface_specifier -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_interface_id_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_interface_definition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_integers -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_integer -> "0" + | MenhirInterpreter.N MenhirInterpreter.N_instance_definition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_inspect_where -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_inspect_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_inspect_spec -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_input_output_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_input_or_using -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_inline_invocation -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_initiate_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_initialize_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_init_data_category -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_informational_paragraphs -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_indexed_by -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_in_of -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_imperative_statement -> Result.Error "bad statement" + | MenhirInterpreter.N MenhirInterpreter.N_imp_stmts -> [] + | MenhirInterpreter.N MenhirInterpreter.N_if_statement_explicit_term -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_if_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_if_body -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_idents -> [] + | MenhirInterpreter.N MenhirInterpreter.N_identification_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_string_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_string -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_numeric -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_nonnumeric_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_nonnumeric -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_nested -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_literal -> Cobol_ast.UPCAST.ident_with_literal dummy_ident + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_integer -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_or_alphanum -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_by_after_before -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_after_before_list -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident_after_before -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ident -> dummy_ident + | MenhirInterpreter.N MenhirInterpreter.N_group_usage_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_group_indicate_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_goback_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_go_to_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_global_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_generate_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_function_unit -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_function_specifier -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_function_name -> dummy_name + | MenhirInterpreter.N MenhirInterpreter.N_function_ident -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_function_id_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_from_to_characters_opt -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_free_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_format_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_for_alphanumeric_or_national_opt -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_floatlit -> floating_zero + | MenhirInterpreter.N MenhirInterpreter.N_float_decimal_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_float_content -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_float_binary_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_flat_combination_operand -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_fixedlit -> fixed_zero + | MenhirInterpreter.N MenhirInterpreter.N_file_with_opt -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_file_status_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_file_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_file_or_sort_merge_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_file_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_file_control_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_figurative_constant -> Zero + | MenhirInterpreter.N MenhirInterpreter.N_factory_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_factory_definition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_external_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_extended_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expression_par_unop -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expression_no_all -> dummy_expr + | MenhirInterpreter.N MenhirInterpreter.N_expression -> Atom (Fig Zero) + | MenhirInterpreter.N MenhirInterpreter.N_expr_unary -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expr_term_par_unop -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expr_term_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expr_term -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expr_factor_par_unop -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expr_factor_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expr_factor -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_expands_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_exit_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_exit_spec -> ExitSimple + | MenhirInterpreter.N MenhirInterpreter.N_evaluate_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_error_or_no_error -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_erase_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_environment_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_entry_name_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_entry_convention_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_enter_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_ending_indicator -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_endianness_mode_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_endianness_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_subtract -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_search -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_multiply -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_divide -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_display -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_add -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_end_accept -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_encoding_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_encoding_endianness_opt -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_encoding_endianness -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_enable_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_else_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_elementary_string_or_int_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_elementary_nonnumeric_literal -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_dynamic_length_structure_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_dynamic_length_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_divide_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_display_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_disable_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_destination_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_depending_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_delete_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_default_section_clauses -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_default_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_default_display_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_default_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_default_accept_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_declaratives -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_decl_section_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_decimal_point_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_debug_target -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_date_day_time -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_value_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_type_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_occurs_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_data_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_cursor_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_currency_sign_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_cs_national -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_cs_alphanumeric -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_crt_status_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_counter -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_control_division -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_control_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_continue_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_value_length -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_value -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_record_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_or_screen_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_or_report_group_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_or_data_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant_level -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_constant -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_configuration_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_compute_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_complex_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_compilation_unit -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_compilation_group -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_communication_section -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_communication_descr_entry -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_communication_descr_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_column_position -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_column_number -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_column_header -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_collating_sequence_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_collating_sequence_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_code_set_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_code_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_close_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_close_format -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_specifier -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_name_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_id_paragraph -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_definition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_condition_no_ident -> ClassNumeric + | MenhirInterpreter.N MenhirInterpreter.N_class_condition -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_class_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_character_set -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_character_classification_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_character_classification -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_cc_national -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_cc_alphanumeric -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_category_to_value -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_capacity_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_cancel_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_call_using_by -> CallUsingByReference + | MenhirInterpreter.N MenhirInterpreter.N_call_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_call_prefix -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_or__RECORD_RECORDS__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_or__LINE_LINES__ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_identification_division_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_87_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_81_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_71_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_60_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_56_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_47_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_46_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_45_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_41_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_3_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_18_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_12_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_11_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_102_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption___anonymous_10_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_YYYYMMDD_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_YYYYDDD_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_STRONG_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_SIGNED_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_SHORT_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_OVERRIDE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_OPTIONAL_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_ONLY_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_NOT_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_MULTIPLE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_IN_ARITHMETIC_RANGE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_INITIALIZED_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_INITIAL_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_GLOBAL_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_CYCLE_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boption_ALL_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_boollit -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_block_contains_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_blank_when_zero_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_blank_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_based_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_atomic_expression_no_all -> dummy_expr + | MenhirInterpreter.N MenhirInterpreter.N_atomic_expression -> dummy_expr + | MenhirInterpreter.N MenhirInterpreter.N_at_eop -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_at_end -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_assign_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_as__strlit_ -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_term_no_all -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_term -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_arithmetic_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_argument -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_area_source -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_any_length_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_and_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_alternate_record_key_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_alter_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_alphabet_specification -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_alphabet_name_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_allocate_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_alignment -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_aligned_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_after_or_before -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_advancing_phrase -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_address -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_add_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_access_mode_clause -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_access_mode -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N_accept_statement -> raise Not_found + | MenhirInterpreter.N MenhirInterpreter.N__assign_external_ -> raise Not_found +end + +let default_value = Default.value + +open MenhirInterpreter + +type action = + | Abort + | R of int + | S : 'a symbol -> action + | Sub of action list + +type decision = + | Nothing + | One of action list + | Select of (int -> action list) + +let depth = + [|0;1;2;3;1;2;3;1;1;2;1;1;3;1;1;1;2;3;2;3;1;1;4;1;4;1;1;2;1;2;3;1;1;2;1;3;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;2;3;1;1;2;1;1;1;1;1;1;1;1;3;2;3;2;1;1;1;4;1;1;2;1;1;3;1;2;5;1;2;6;7;1;2;3;4;5;5;6;7;1;2;3;4;1;2;5;1;2;3;6;1;2;7;8;2;1;2;1;2;3;1;1;1;1;1;1;1;1;4;1;1;2;3;1;1;1;1;1;2;1;2;4;1;2;3;4;1;2;3;1;2;1;3;4;5;1;2;1;1;1;1;3;1;1;2;1;2;1;1;1;1;1;1;3;3;1;2;3;1;2;3;1;2;1;3;3;1;1;2;3;4;5;1;4;1;2;3;3;1;2;1;1;1;3;1;1;1;2;3;1;1;1;4;1;1;4;5;1;1;1;2;3;1;2;3;4;2;3;4;1;2;3;1;1;1;1;1;2;1;1;2;4;1;2;1;2;3;1;1;1;1;4;2;3;4;1;2;3;1;1;3;1;1;2;1;1;2;1;1;2;1;1;5;1;2;1;1;2;1;1;2;2;3;4;1;2;5;1;1;1;1;2;1;1;3;4;1;2;1;2;3;4;5;1;2;3;1;4;1;1;2;1;3;4;5;1;1;6;1;1;1;2;3;1;2;3;1;2;3;1;1;2;3;4;5;1;1;2;3;4;5;6;1;2;3;4;1;2;3;4;1;1;1;1;1;2;1;2;3;1;1;1;2;3;1;5;6;1;2;3;4;1;1;1;1;1;1;1;2;1;2;3;1;2;3;2;1;1;1;1;2;5;1;1;1;2;1;1;1;2;3;4;5;6;7;8;1;2;3;4;5;6;7;8;1;2;3;1;1;2;1;1;1;1;1;1;1;1;1;3;4;3;1;1;6;1;2;1;2;3;1;2;3;1;2;3;1;2;3;4;4;1;1;1;2;3;2;3;2;3;1;2;3;4;1;2;1;1;1;3;4;1;7;1;1;1;1;1;1;4;1;2;3;1;2;1;1;2;3;1;2;1;2;1;1;2;1;2;3;1;2;1;1;3;1;1;2;3;4;1;2;3;1;4;2;3;4;1;2;3;5;1;1;1;2;3;1;2;3;1;1;4;1;1;2;1;1;1;3;1;2;1;2;3;1;1;4;1;2;3;1;4;5;5;5;1;1;2;3;1;2;1;3;1;1;4;1;2;5;1;1;1;2;1;1;1;2;3;4;5;1;2;3;6;1;2;7;1;2;3;1;1;1;4;1;1;1;1;1;1;1;1;1;1;2;3;4;1;2;3;4;4;5;6;1;2;2;3;2;1;1;1;1;1;1;4;5;1;1;2;3;1;4;1;2;1;1;2;2;1;3;1;1;2;3;4;5;3;4;5;4;1;1;2;3;4;2;1;1;1;1;1;1;2;1;3;4;5;6;1;2;2;1;2;1;3;1;4;5;1;1;2;2;3;1;3;4;1;2;1;1;1;2;3;1;1;5;1;1;1;1;5;1;1;1;1;4;1;2;3;1;1;2;3;4;5;1;6;1;2;7;3;4;5;6;7;3;4;5;1;2;6;2;3;4;1;2;3;1;2;3;1;2;1;2;3;1;4;5;1;2;3;1;2;3;4;5;3;1;6;1;1;2;3;7;1;1;2;3;4;5;6;4;1;1;1;1;2;3;1;2;3;1;1;2;1;1;3;4;1;1;1;2;1;2;1;1;1;1;1;1;1;1;1;2;3;1;1;1;1;2;3;1;2;3;1;1;1;1;1;1;1;1;1;1;2;3;1;1;4;5;1;1;1;1;1;1;1;1;1;1;1;1;1;2;3;1;1;1;1;1;1;1;1;1;1;2;1;1;1;1;1;1;2;3;1;1;1;2;1;2;3;3;1;2;1;2;3;1;1;1;1;1;2;3;2;3;1;1;2;3;1;1;2;3;2;3;2;3;2;3;1;2;3;1;1;2;4;1;1;1;1;2;3;3;4;5;6;3;4;2;3;4;1;2;3;1;1;2;1;1;1;2;3;1;2;1;1;1;1;1;1;1;1;2;1;1;2;1;2;3;1;3;2;3;2;3;2;3;2;3;2;3;1;2;3;1;2;3;2;3;2;3;2;3;2;3;1;1;2;3;3;4;1;1;2;3;3;4;5;6;1;1;2;3;4;5;6;7;1;4;1;3;2;3;4;2;3;2;3;4;6;7;8;9;4;5;6;7;8;9;10;4;5;6;7;2;3;2;3;2;3;1;2;2;2;1;2;3;4;1;1;1;2;1;2;1;1;3;1;2;4;1;5;1;2;3;3;1;2;3;3;1;2;3;1;4;1;2;1;5;1;1;1;1;1;2;2;1;6;7;1;1;8;1;2;1;2;1;2;1;1;2;1;2;1;1;2;1;2;3;1;1;1;2;1;3;1;2;1;1;1;2;3;1;1;1;1;2;1;1;2;1;1;1;2;1;1;2;1;2;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;1;1;1;2;1;2;1;2;1;3;1;1;2;1;2;3;1;2;2;1;2;1;2;3;3;1;2;3;1;2;1;2;1;2;3;1;1;2;3;3;1;2;1;2;1;1;2;1;2;2;2;1;1;2;1;2;1;3;4;5;6;2;2;2;3;4;5;6;2;2;3;2;1;1;1;2;3;4;5;1;2;2;3;3;3;4;5;6;7;3;3;3;4;5;6;7;3;3;4;3;2;2;2;3;4;5;6;2;2;2;3;4;5;6;2;2;3;2;3;1;1;4;1;1;1;1;1;1;1;1;1;1;1;1;1;1;4;1;1;4;1;1;2;3;4;5;1;1;2;1;2;3;2;3;3;3;3;4;2;1;3;2;3;2;2;2;1;2;3;1;2;1;2;1;3;2;3;2;3;1;1;2;3;2;3;3;4;2;3;4;3;4;2;2;3;1;1;2;3;1;2;3;4;5;1;2;4;5;1;1;1;2;1;2;3;3;1;2;4;1;2;5;1;6;1;2;3;1;4;1;2;1;1;2;3;4;7;1;1;2;3;8;1;1;1;2;1;1;1;1;2;3;4;1;5;6;7;8;3;4;5;1;1;2;1;2;1;2;1;2;3;4;1;2;3;3;1;2;1;1;2;3;1;2;3;4;1;1;2;3;1;2;3;3;3;2;1;2;1;2;2;2;4;1;2;3;5;6;4;5;1;2;1;1;1;1;1;1;3;1;2;3;1;1;2;1;1;1;1;1;1;1;1;1;1;1;3;4;1;1;1;1;1;1;1;2;1;2;3;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;1;1;1;1;1;1;1;2;3;4;1;2;5;6;1;5;1;1;1;2;1;2;3;4;5;1;2;6;7;8;1;1;2;3;4;5;6;1;1;2;1;2;3;3;4;5;6;7;8;1;1;1;2;1;2;3;1;2;3;4;1;1;1;2;3;1;2;3;1;2;3;4;1;1;1;1;2;1;2;2;3;2;3;1;2;1;3;2;3;2;3;1;2;1;2;3;4;5;6;6;4;4;1;3;4;5;1;1;1;1;2;1;3;1;3;1;4;5;6;7;1;2;3;4;1;1;2;3;4;1;1;1;1;1;2;1;1;1;1;4;1;1;2;4;1;2;3;4;1;5;1;2;3;4;6;1;2;3;4;7;1;2;3;1;2;3;4;1;2;3;4;1;2;3;4;1;2;3;4;1;2;3;4;2;3;4;1;2;3;4;1;2;3;4;1;2;3;4;5;1;2;3;6;2;3;4;2;3;5;6;7;1;2;3;4;2;3;4;2;3;4;2;3;4;2;3;4;2;3;4;1;2;3;4;1;1;2;1;4;5;6;7;8;9;1;2;1;5;6;7;8;9;1;1;1;2;4;1;1;2;8;1;2;3;1;2;1;1;2;1;2;2;3;1;2;3;4;1;2;3;4;5;6;2;3;4;1;2;1;7;8;9;1;10;1;2;3;11;1;1;6;7;1;1;1;2;3;4;2;3;4;2;2;1;2;3;4;3;1;2;3;4;3;1;2;3;3;4;1;2;1;2;1;2;1;2;3;3;1;2;1;1;1;2;2;1;1;1;2;2;3;1;2;2;1;1;3;1;1;2;1;1;1;1;2;1;4;3;1;2;1;2;3;1;2;3;1;2;4;3;3;3;3;1;2;3;1;2;4;1;1;1;2;2;1;2;1;2;1;2;3;4;5;6;1;2;1;7;1;3;4;5;1;2;3;4;5;4;5;4;5;1;2;6;4;1;2;1;1;2;1;2;1;2;1;1;2;3;1;1;1;1;1;2;1;1;1;2;3;1;2;3;1;1;2;1;1;1;3;4;1;1;1;1;1;1;1;1;1;1;1;1;2;3;4;2;3;4;5;1;2;1;2;1;2;3;1;1;2;1;1;2;1;2;2;1;2;1;1;2;1;2;3;2;1;1;1;2;1;2;1;2;3;1;1;1;2;1;1;5;1;1;1;2;1;1;1;2;1;1;1;1;4;1;2;1;9;1;2;3;1;2;1;2;3;1;2;1;1;2;1;1;1;1;2;3;1;1;1;2;3;1;1;1;1;1;4;1;1;2;1;1;1;1;1;1;1;2;1;2;3;1;1;1;1;1;2;3;3;2;2;1;2;3;4;1;2;3;4;1;1;2;2;1;1;2;3;1;1;1;2;1;1;1;1;1;1;1;2;1;1;1;1;2;1;1;1;1;1;3;4;1;1;4;1;1;2;1;1;10;1;1;1;1;1;1;1;1;1;1;1;1;5;1;2;3;1;2;1;1;2;3;2;1;2;3;2;3;2;1;1;2;4;1;2;5;1;1;2;2;1;2;3;6;1;2;1;1;1;3;4;5;6;1;1;2;3;1;2;3;1;4;5;1;1;1;1;1;6;1;3;4;5;6;2;3;4;5;6;7;4;5;6;7;3;4;5;6;3;4;5;6;3;4;5;6;7;8;5;6;7;8;4;5;6;7;4;5;6;7;2;3;4;3;1;2;1;1;2;3;2;1;4;1;3;4;5;2;3;4;5;2;3;2;3;2;3;4;5;6;7;4;5;6;7;3;4;5;4;5;4;5;6;3;4;5;6;3;4;3;4;2;3;4;1;1;2;2;3;5;1;1;2;1;1;2;1;2;3;2;3;4;5;4;1;1;2;3;1;1;2;2;1;2;3;1;1;4;1;2;2;3;4;2;3;5;1;2;3;2;1;2;1;6;7;1;2;1;2;1;2;1;3;1;4;1;2;3;4;1;5;3;4;1;2;1;1;2;3;2;1;2;3;3;1;1;5;6;7;8;1;1;9;1;2;1;1;3;1;2;3;4;1;5;6;1;2;3;1;7;1;1;1;1;1;2;1;1;2;1;1;2;3;4;5;6;1;1;2;3;4;5;1;2;1;1;1;2;3;4;1;3;1;2;1;2;3;1;2;3;3;4;1;2;1;2;3;4;1;2;1;1;5;1;5;1;2;3;4;5;1;2;6;1;4;5;6;1;7;8;9;10;1;2;3;1;3;4;5;6;7;1;2;3;4;2;3;4;1;2;1;1;2;1;1;1;1;1;1;1;1;3;4;1;1;5;1;1;2;3;4;5;2;3;4;5;1;1;2;1;1;1;1;2;6;1;7;1;2;2;3;4;1;1;5;2;2;3;4;2;2;3;4;1;1;5;2;2;3;4;2;1;1;1;1;1;1;1;1;1;2;2;2;1;3;2;1;2;1;2;3;4;2;3;1;1;1;2;3;4;1;3;2;3;4;4;5;4;1;2;3;4;5;1;1;1;1;6;7;1;2;8;1;1;1;2;3;3;1;1;4;1;3;4;5;6;1;2;3;4;5;6;1;2;1;3;4;5;6;7;1;2;3;1;2;4;1;1;5;1;2;3;4;3;1;2;3;1;1;2;1;1;3;4;5;1;6;1;2;1;1;3;4;1;2;5;1;2;1;2;3;6;7;1;2;3;8;9;1;2;3;2;1;2;1;1;1;1;1;2;3;1;2;3;1;2;1;1;3;1;2;1;1;1;4;5;6;1;4;2;3;2;1;2;1;1;1;2;3;1;2;3;4;1;1;1;2;3;1;1;2;2;1;1;2;1;1;1;2;1;1;2;3;1;2;1;2;4;5;1;2;3;4;5;2;3;4;1;2;3;4;5;6;7;1;2;1;3;1;1;1;2;2;1;2;2;2;2;1;2;1;4;5;1;1;1;1;2;1;1;2;3;1;2;1;1;2;3;1;1;2;3;1;2;3;4;1;1;2;1;2;1;2;1;2;3;4;1;2;4;1;2;1;2;1;2;1;1;2;2;1;2;1;2;1;2;1;2;3;1;1;2;1;2;3;4;5;3;1;2;1;2;3;4;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;3;5;6;7;8;5;2;3;1;2;3;4;5;6;7;1;2;3;5;6;7;8;9;6;7;8;3;4;5;6;7;4;5;6;4;5;6;7;8;5;6;7;3;4;5;6;3;4;5;3;4;5;6;7;4;5;6;1;2;3;1;2;1;2;3;1;1;2;3;2;3;2;2;1;1;1;2;3;4;5;6;3;1;2;1;1;2;1;2;1;1;1;2;1;1;2;1;1;2;1;2;2;1;1;1;2;1;1;1;2;3;4;5;1;2;3;3;3;1;1;2;1;2;3;1;2;1;1;1;2;3;4;1;1;2;2;2;1;2;1;1;1;2;3;4;1;1;1;2;1;1;2;1;2;3;1;2;1;1;3;1;2;1;2;3;4;5;1;2;1;3;1;2;1;2;3;4;5;1;1;2;3;4;5;1;2;1;1;1;2;2;1;2;2;3;1;1;2;3;2;1;1;2;1;1;2;1;1;1;2;1;3;1;2;3;4;5;1;1;2;1;2;3;4;5;2;1;2;3;4;2;3;4;5;1;2;3;4;5;6;1;2;3;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;4;1;1;3;4;5;1;3;1;2;3;1;2;3;1;2;3;4;5;6;7;5;6;3;4;7;5;6;5;1;2;1;2;3;4;5;3;4;5;3;4;2;3;1;4;5;6;7;8;6;7;8;6;7;6;1;1;1;2;1;1;2;4;5;4;5;3;7;3;4;1;8;6;7;3;4;8;6;7;6;2;3;4;5;6;7;5;6;7;5;6;5;1;4;5;6;7;8;9;7;8;9;7;8;7;1;3;4;5;6;7;5;6;7;5;6;5;1;1;2;6;7;5;5;6;7;5;6;7;5;6;6;7;5;6;7;5;5;6;6;3;4;7;5;6;3;4;7;5;5;6;4;1;5;3;4;5;6;7;5;6;7;5;6;5;3;4;5;3;4;2;1;2;3;1;2;2;2;2;2;1;2;3;4;3;4;5;4;3;1;4;5;6;5;1;1;1;2;3;6;1;7;5;6;7;5;6;5;4;5;6;1;2;7;8;9;10;8;9;10;8;9;8;1;3;4;5;6;7;8;9;10;8;9;10;8;9;8;2;3;1;2;3;2;4;5;1;1;2;3;1;2;3;1;2;4;5;6;1;7;5;6;7;5;6;5;4;5;6;7;8;9;7;8;9;7;8;7;3;4;1;2;1;2;3;4;1;1;2;3;1;2;1;1;1;10;11;9;10;11;3;4;9;10;11;9;9;10;9;10;9;10;3;4;11;1;1;1;1;1;1;1;7;8;1;8;9;10;6;6;7;8;6;7;8;9;7;1;8;9;7;8;9;7;7;8;1;7;8;1;9;1;2;1;2;3;4;5;3;4;5;7;8;2;4;5;6;7;8;9;10;11;9;10;2;1;2;3;1;2;3;4;3;1;4;2;5;4;5;6;7;1;4;5;3;4;5;6;4;5;6;4;4;5;3;1;4;5;6;7;8;6;7;8;6;6;7;8;9;10;11;9;10;11;9;9;10;6;7;3;4;5;3;4;5;6;4;5;6;4;4;5;3;3;4;6;7;3;4;5;5;6;7;8;9;10;8;8;9;3;4;10;8;9;5;6;7;5;6;2;1;1;2;3;3;1;2;1;7;1;8;6;7;8;6;7;6;2;3;4;5;6;7;5;6;7;5;6;5;4;5;6;7;8;9;7;8;9;7;8;7;10;11;9;9;10;11;9;10;6;7;8;6;6;7;8;9;10;11;12;13;14;12;12;13;14;12;13;9;10;11;9;9;10;11;9;10;6;7;8;6;7;1;8;9;7;8;1;9;1;1;3;4;7;8;9;7;7;8;7;8;7;8;3;4;9;1;1;2;1;2;1;2;4;1;1;1;1;2;7;1;1;1;2;2;3;4;2;8;1;1;6;7;8;9;1;3;4;5;6;4;5;6;7;6;7;8;9;10;1;1;1;1;1;1;1;1;4;1;1;2;1;1;5;6;7;8;9;1;1;2;3;4;5;6;7;8;9;10;2;3;4;5;6;7;8;9;1;1;2;1;2;3;3;1;2;1;2;3;3;2;3;4;5;6;7;8;9;2;3;4;5;6;7;8;9;1;1;5;6;7;8;9;10;1;1;1;1;1;2;1;1;1;2;3;4;5;6;1;1;1;1;2;3;2;1;1;1;2;1;3;1;4;1;5;3;4;5;6;1;2;3;4;5;6;7;1;2;8;1;2;1;2;1;1;1;6;7;8;9;3;4;5;6;4;5;6;7;7;1;1;2;3;4;5;6;1;3;4;1;1;1;2;1;1;1;2;3;4;5;6;7;2;3;4;5;6;7;8;9;10;1;1;1;1;0;1;1;2;|] + +let can_pop (type a) : a terminal -> bool = function + | T_ZERO_FILL -> true + | T_ZERO -> true + | T_YYYYMMDD -> true + | T_YYYYDDD -> true + | T_Y -> true + | T_XOR -> true + | T_XML_SCHEMA -> true + | T_XML_DECLARATION -> true + | T_XML -> true + | T_X -> true + | T_WRITE_VERIFY -> true + | T_WRITE_ONLY -> true + | T_WRITERS -> true + | T_WRITE -> true + | T_WRAP -> true + | T_WORKING_STORAGE -> true + | T_WORDS -> true + | T_WITH_DATA -> true + | T_WITH -> true + | T_WINDOW -> true + | T_WIDTH_IN_CELLS -> true + | T_WIDTH -> true + | T_WHEN -> true + | T_WEB_BROWSER -> true + | T_WAIT -> true + | T_VTOP -> true + | T_VSCROLL_POS -> true + | T_VSCROLL_BAR -> true + | T_VSCROLL -> true + | T_VPADDING -> true + | T_VOLATILE -> true + | T_VLR -> true + | T_VIRTUAL_WIDTH -> true + | T_VIRTUAL -> true + | T_VIA -> true + | T_VERY_HEAVY -> true + | T_VERTICAL -> true + | T_VARYING -> true + | T_VARIANT -> true + | T_VARIABLE -> true + | T_VALUE_FORMAT -> true + | T_VALUES -> true + | T_VALUE -> true + | T_VALIDATING -> true + | T_VALIDATE_STATUS -> true + | T_VALIDATE -> true + | T_VALID -> true + | T_V -> true + | T_UTF_8 -> true + | T_UTF_16 -> true + | T_USING -> true + | T_USE_TAB -> true + | T_USE_RETURN -> true + | T_USE_ALT -> true + | T_USER_DEFAULT -> true + | T_USER -> true + | T_USE -> true + | T_USAGE -> true + | T_UPPER -> true + | T_UPON -> true + | T_UPDATERS -> true + | T_UPDATE -> true + | T_UP -> true + | T_UNUSED__ -> true + | T_UNTIL -> true + | T_UNSTRING -> true + | T_UNSORTED -> true + | T_UNSIGNED_SHORT -> true + | T_UNSIGNED_LONG -> true + | T_UNSIGNED_INT -> true + | T_UNSIGNED -> true + | T_UNSEQUAL -> true + | T_UNLOCK -> true + | T_UNIVERSAL -> true + | T_UNIT -> true + | T_UNFRAMED -> true + | T_UNDERLINE -> true + | T_UNBOUNDED -> true + | T_UFF -> true + | T_UCS_4 -> true + | T_U -> true + | T_TYPEDEF -> true + | T_TYPE -> true + | T_TRUNCATION -> true + | T_TRUE -> true + | T_TREE_VIEW -> true + | T_TRANSPARENT -> true + | T_TRANSFORM -> true + | T_TRAILING_SIGN -> true + | T_TRAILING_SHIFT -> true + | T_TRAILING -> true + | T_TRADITIONAL_FONT -> true + | T_TRACK_LIMIT -> true + | T_TRACK_AREA -> true + | T_TRACKS -> true + | T_TRACK -> true + | T_TOWARD_LESSER -> true + | T_TOWARD_GREATER -> true + | T_TOP_LEVEL -> true + | T_TOP -> true + | T_TO -> true + | T_TITLE_POSITION -> true + | T_TITLE -> true + | T_TIME_OUT -> true + | T_TIMES -> true + | T_TIME -> true + | T_TILED_HEADINGS -> true + | T_THUMB_POSITION -> true + | T_THROUGH -> true + | T_THREEDIMENSIONAL -> true + | T_THREADS -> true + | T_THREAD -> true + | T_THEN -> true + | T_THAN -> true + | T_TEXT -> true + | T_TEST -> true + | T_TERMINATION_VALUE -> true + | T_TERMINATE -> true + | T_TERMINAL_X -> true + | T_TERMINAL_INFO -> true + | T_TERMINAL_3 -> true + | T_TERMINAL_2 -> true + | T_TERMINAL_1 -> true + | T_TERMINAL_0 -> true + | T_TERMINAL -> true + | T_TEMPORARY -> true + | T_TEMP -> true + | T_TAPE -> true + | T_TALLYING -> true + | T_TAB_TO_DELETE -> true + | T_TAB_TO_ADD -> true + | T_TABLE -> true + | T_TAB -> true + | T_SYSTEM_OFFSET -> true + | T_SYSTEM_INFO -> true + | T_SYSTEM_DEFAULT -> true + | T_SYSTEM -> true + | T_SYSOUT_X -> true + | T_SYSOUT_3 -> true + | T_SYSOUT_2 -> true + | T_SYSOUT_1 -> true + | T_SYSOUT_0 -> true + | T_SYSIN_X -> true + | T_SYSIN_3 -> true + | T_SYSIN_2 -> true + | T_SYSIN_1 -> true + | T_SYSIN_0 -> true + | T_SYNCHRONIZED -> true + | T_SYMBOLIC -> true + | T_SYMBOL -> true + | T_SWITCH -> true + | T_SUPPRESS -> true + | T_SUPER -> true + | T_SUM -> true + | T_SUB_SCHEMA -> true + | T_SUB_QUEUE_3 -> true + | T_SUB_QUEUE_2 -> true + | T_SUB_QUEUE_1 -> true + | T_SUBWINDOW -> true + | T_SUBTRACT -> true + | T_STYLE -> true + | T_STRUCTURE -> true + | T_STRONG -> true + | T_STRING -> true + | T_STOP -> true + | T_STEP -> true + | T_STDCALL -> true + | T_STATUS_TEXT -> true + | T_STATUS_BAR -> true + | T_STATUS -> true + | T_STATION -> true + | T_STATIC_LIST -> true + | T_STATIC -> true + | T_STATEMENT -> true + | T_START_Y -> true + | T_START_X -> true + | T_START -> true + | T_STANDARD_DECIMAL -> true + | T_STANDARD_BINARY -> true + | T_STANDARD_2 -> true + | T_STANDARD_1 -> true + | T_STANDARD -> true + | T_STACK -> true + | T_SSF -> true + | T_SQUARE -> true + | T_SPINNER -> true + | T_SPECIAL_NAMES -> true + | T_SPACE_FILL -> true + | T_SPACE -> true + | T_SOURCE_COMPUTER -> true + | T_SOURCES -> true + | T_SOURCE -> true + | T_SORT_ORDER -> true + | T_SORT_MERGE -> true + | T_SORT -> true + | T_SMALL_FONT -> true + | T_SLASH -> true + | T_SIZE -> true + | T_SIGNED_SHORT -> true + | T_SIGNED_LONG -> true + | T_SIGNED_INT -> true + | T_SIGNED -> true + | T_SIGN -> true + | T_SHOW_SEL_ALWAYS -> true + | T_SHOW_NONE -> true + | T_SHOW_LINES -> true + | T_SHORT_DATE -> true + | T_SHORT -> true + | T_SHARING -> true + | T_SHADOW -> true + | T_SHADING -> true + | T_SET -> true + | T_SEQUENTIAL -> true + | T_SEQUENCE -> true + | T_SEPARATION -> true + | T_SEPARATE -> true + | T_SENTENCE -> true + | T_SEND -> true + | T_SELF_ACT -> true + | T_SELF -> true + | T_SELECT_ALL -> true + | T_SELECTION_TEXT -> true + | T_SELECTION_INDEX -> true + | T_SELECTION -> true + | T_SELECT -> true + | T_SEGMENT_LIMIT -> true + | T_SEGMENT -> true + | T_SECURE -> true + | T_SECTION -> true + | T_SECONDS -> true + | T_SECONDARY -> true + | T_SEARCH_TEXT -> true + | T_SEARCH_OPTIONS -> true + | T_SEARCH -> true + | T_SD -> true + | T_SCROLL_BAR -> true + | T_SCROLL -> true + | T_SCREEN -> true + | T_SAVE_AS_NO_PROMPT -> true + | T_SAVE_AS -> true + | T_SARF -> true + | T_SAME -> true + | T_S -> true + | T_RUN -> true + | T_RPAR -> true + | T_ROW_PROTECTION -> true + | T_ROW_HEADINGS -> true + | T_ROW_FONT -> true + | T_ROW_DIVIDERS -> true + | T_ROW_COLOR_PATTERN -> true + | T_ROW_COLOR -> true + | T_ROUNDING -> true + | T_ROUNDED -> true + | T_ROLLBACK -> true + | T_RIMMED -> true + | T_RIGHT_JUSTIFY -> true + | T_RIGHT_ALIGN -> true + | T_RIGHT -> true + | T_RH -> true + | T_RF -> true + | T_REWRITE -> true + | T_REWIND -> true + | T_REVERSE_VIDEO -> true + | T_REVERSED -> true + | T_REVERSE -> true + | T_RETURNING -> true + | T_RETURN -> true + | T_RETRY -> true + | T_RETENTION -> true + | T_RESUME -> true + | T_RESET_TABS -> true + | T_RESET_LIST -> true + | T_RESET_GRID -> true + | T_RESET -> true + | T_RESERVE -> true + | T_RERUN -> true + | T_REREAD -> true + | T_REQUIRED -> true + | T_REPOSITORY -> true + | T_REPORTS -> true + | T_REPORTING -> true + | T_REPORT -> true + | T_REPLACING -> true + | T_REPLACE -> true + | T_REPEATED -> true + | T_REORG_CRITERIA -> true + | T_RENAMES -> true + | T_REMOVAL -> true + | T_REMAINDER -> true + | T_RELEASE -> true + | T_RELATIVE -> true + | T_RELATION -> true + | T_REGION_COLOR -> true + | T_REFRESH -> true + | T_REFERENCES -> true + | T_REFERENCE -> true + | T_REEL -> true + | T_REDEFINES -> true + | T_RECURSIVE -> true + | T_RECORD_TO_DELETE -> true + | T_RECORD_TO_ADD -> true + | T_RECORD_OVERFLOW -> true + | T_RECORD_DATA -> true + | T_RECORDS -> true + | T_RECORDING -> true + | T_RECORD -> true + | T_RECEIVED -> true + | T_RECEIVE -> true + | T_READ_ONLY -> true + | T_READERS -> true + | T_READ -> true + | T_RD -> true + | T_RANDOM -> true + | T_RAISING -> true + | T_RAISED -> true + | T_RAISE -> true + | T_RADIO_BUTTON -> true + | T_QUOTE -> true + | T_QUEUED -> true + | T_QUEUE -> true + | T_QUERY_INDEX -> true + | T_PUSH_BUTTON -> true + | T_PURGE -> true + | T_PROTOTYPE -> true + | T_PROTECTED -> true + | T_PROPERTY -> true + | T_PROPERTIES -> true + | T_PROMPT -> true + | T_PROHIBITED -> true + | T_PROGRESS -> true + | T_PROGRAM_POINTER -> true + | T_PROGRAM_ID -> true + | T_PROGRAM -> true + | T_PROCESS_AREA -> true + | T_PROCESSING -> true + | T_PROCEED -> true + | T_PROCEDURE_POINTER -> true + | T_PROCEDURES -> true + | T_PROCEDURE -> true + | T_PRIORITY -> true + | T_PRINT_PREVIEW -> true + | T_PRINT_NO_PROMPT -> true + | T_PRINTING -> true + | T_PRINTER_1 -> true + | T_PRINTER -> true + | T_PRINT -> true + | T_PRIMARY -> true + | T_PREVIOUS -> true + | T_PRESENT -> true + | T_PREFIXED -> true + | T_POSITIVE -> true + | T_POSITION_SHIFT -> true + | T_POSITION -> true + | T_POS -> true + | T_POP_UP -> true + | T_POINTER -> true + | T_PLUS_SIGN -> true + | T_PLUS -> true + | T_PLACEMENT -> true + | T_PIXEL -> true + | T_PICTURE -> true + | T_PHYSICAL -> true + | T_PH -> true + | T_PF -> true + | T_PERMANENT -> true + | T_PERIOD -> true + | T_PERFORM -> true + | T_PASSWORD -> true + | T_PASCAL -> true + | T_PARSE -> true + | T_PARENT -> true + | T_PARAGRAPH -> true + | T_PAGE_SETUP -> true + | T_PAGE_COUNTER -> true + | T_PAGED -> true + | T_PAGE -> true + | T_PADDING -> true + | T_PACKED_DECIMAL -> true + | T_OVERRIDING -> true + | T_OVERRIDE -> true + | T_OVERLINE -> true + | T_OVERLAP_TOP -> true + | T_OVERLAP_LEFT -> true + | T_OVERFLOW -> true + | T_OUTPUT -> true + | T_OTHERS -> true + | T_OTHER -> true + | T_ORGANIZATION -> true + | T_ORDER -> true + | T_OR -> true + | T_OPTIONS -> true + | T_OPTIONAL -> true + | T_OPERATIONAL -> true + | T_OPEN -> true + | T_ON_SIZE_ERROR -> true + | T_ON_OVERFLOW -> true + | T_ON_EXCEPTION -> true + | T_ONLY -> true + | T_ON -> true + | T_OMITTED -> true + | T_OK_BUTTON -> true + | T_OFF -> true + | T_OF -> true + | T_OCCURS -> true + | T_OBJECT_REFERENCE -> true + | T_OBJECT_PROGRAM -> true + | T_OBJECT_COMPUTER -> true + | T_OBJECT -> true + | T_NUM_ROWS -> true + | T_NUM_COL_HEADINGS -> true + | T_NUMERIC_EDITED -> true + | T_NUMERIC -> true + | T_NUMBERS -> true + | T_NUMBER -> true + | T_NULLS -> true + | T_NULL -> true + | T_NO_UPDOWN -> true + | T_NO_SEARCH -> true + | T_NO_KEY_LETTER -> true + | T_NO_GROUP_TAB -> true + | T_NO_FOCUS -> true + | T_NO_F4 -> true + | T_NO_ECHO -> true + | T_NO_DIVIDERS -> true + | T_NO_DATA -> true + | T_NO_BOX -> true + | T_NO_AUTO_DEFAULT -> true + | T_NO_AUTOSEL -> true + | T_NOT_ON_SIZE_ERROR -> true + | T_NOT_ON_OVERFLOW -> true + | T_NOT_ON_EXCEPTION -> true + | T_NOT_INVALID_KEY -> true + | T_NOT_AT_EOP -> true + | T_NOT_AT_END -> true + | T_NOTIFY_SELCHANGE -> true + | T_NOTIFY_DBLCLICK -> true + | T_NOTIFY_CHANGE -> true + | T_NOTIFY -> true + | T_NOTHING -> true + | T_NOTAB -> true + | T_NOT -> true + | T_NORMAL -> true + | T_NONNUMERIC -> true + | T_NONE -> true + | T_NOMINAL -> true + | T_NO -> true + | T_NEXT_PAGE -> true + | T_NEXT_ITEM -> true + | T_NEXT -> true + | T_NEW -> true + | T_NESTED -> true + | T_NEGATIVE -> true + | T_NEAREST_TO_ZERO -> true + | T_NEAREST_TOWARD_ZERO -> true + | T_NEAREST_EVEN -> true + | T_NEAREST_AWAY_FROM_ZERO -> true + | T_NE -> true + | T_NAVIGATE_URL -> true + | T_NATIVE -> true + | T_NATIONAL_EDITED -> true + | T_NATIONAL -> true + | T_NAT -> true + | T_NAMESPACE_PREFIX -> true + | T_NAMESPACE -> true + | T_NAMED -> true + | T_NAME -> true + | T_MULTIPLY -> true + | T_MULTIPLE -> true + | T_MULTILINE -> true + | T_MOVE -> true + | T_MODULES -> true + | T_MODIFY -> true + | T_MODE -> true + | T_MIN_VAL -> true + | T_MINUS -> true + | T_MICROSECOND_TIME -> true + | T_METHOD_ID -> true + | T_METHOD -> true + | T_MESSAGE_TAG -> true + | T_MESSAGE -> true + | T_MERGE -> true + | T_MENU -> true + | T_MEMORY -> true + | T_MEDIUM_FONT -> true + | T_MAX_VAL -> true + | T_MAX_TEXT -> true + | T_MAX_PROGRESS -> true + | T_MAX_LINES -> true + | T_MASTER_INDEX -> true + | T_MASS_UPDATE -> true + | T_MANUAL -> true + | T_MAGNETIC_TAPE -> true + | T_LT -> true + | T_LPAR -> true + | T_LOW_VALUE -> true + | T_LOW_COLOR -> true + | T_LOWLIGHT -> true + | T_LOWERED -> true + | T_LOWER -> true + | T_LONG_DATE -> true + | T_LOCK_HOLDING -> true + | T_LOCKS -> true + | T_LOCK -> true + | T_LOCATION -> true + | T_LOCAL_STORAGE -> true + | T_LOCALE -> true + | T_LOC -> true + | T_LM_RESIZE -> true + | T_LIST_BOX -> true + | T_LINKAGE -> true + | T_LINE_SEQUENTIAL -> true + | T_LINE_COUNTER -> true + | T_LINES_PER_PAGE -> true + | T_LINES_AT_ROOT -> true + | T_LINES -> true + | T_LINE -> true + | T_LINAGE_COUNTER -> true + | T_LINAGE -> true + | T_LIMITS -> true + | T_LIMIT -> true + | T_LIKE -> true + | T_LIBRARY -> true + | T_LESS -> true + | T_LENGTH -> true + | T_LEFT_TEXT -> true + | T_LEFT_JUSTIFY -> true + | T_LEFTLINE -> true + | T_LEFT -> true + | T_LEAVE -> true + | T_LEADING_SHIFT -> true + | T_LEADING -> true + | T_LE -> true + | T_LC_TIME -> true + | T_LC_NUMERIC -> true + | T_LC_MONETARY -> true + | T_LC_MESSAGES -> true + | T_LC_CTYPE -> true + | T_LC_COLLATE -> true + | T_LC_ALL -> true + | T_LAYOUT_MANAGER -> true + | T_LAYOUT_DATA -> true + | T_LAST_ROW -> true + | T_LAST -> true + | T_LARGE_OFFSET -> true + | T_LARGE_FONT -> true + | T_LABEL_OFFSET -> true + | T_LABEL -> true + | T_KEY_LOCATION -> true + | T_KEYED -> true + | T_KEYBOARD -> true + | T_KEY -> true + | T_KEPT -> true + | T_JUSTIFIED -> true + | T_JSON -> true + | T_I_O_CONTROL -> true + | T_I_O -> true + | T_ITEM_VALUE -> true + | T_ITEM_TO_EMPTY -> true + | T_ITEM_TO_DELETE -> true + | T_ITEM_TO_ADD -> true + | T_ITEM_TEXT -> true + | T_ITEM -> true + | T_IS_TYPEDEF -> true + | T_IS_GLOBAL -> true + | T_IS_EXTERNAL -> true + | T_IS -> true + | T_IN_ARITHMETIC_RANGE -> true + | T_INVOKING -> true + | T_INVOKE -> true + | T_INVALID_KEY -> true + | T_INVALID -> true + | T_INTRINSIC -> true + | T_INTO -> true + | T_INTERMEDIATE -> true + | T_INTERFACE_ID -> true + | T_INTERFACE -> true + | T_INSPECT -> true + | T_INSERT_ROWS -> true + | T_INSERTION_INDEX -> true + | T_INQUIRE -> true + | T_INPUT_OUTPUT -> true + | T_INPUT -> true + | T_INITIATE -> true + | T_INITIALIZED -> true + | T_INITIALIZE -> true + | T_INITIAL -> true + | T_INHERITS -> true + | T_INDICATE -> true + | T_INDEX_2 -> true + | T_INDEX_1 -> true + | T_INDEXED -> true + | T_INDEX -> true + | T_INDEPENDENT -> true + | T_IN -> true + | T_IMPLEMENTS -> true + | T_IGNORING -> true + | T_IGNORE -> true + | T_IF -> true + | T_IDS_II -> true + | T_IDENTIFIED -> true + | T_IDENTIFICATION -> true + | T_ID -> true + | T_ICON -> true + | T_HSCROLL_POS -> true + | T_HSCROLL -> true + | T_HOT_TRACK -> true + | T_HIGH_VALUE -> true + | T_HIGH_ORDER_RIGHT -> true + | T_HIGH_ORDER_LEFT -> true + | T_HIGH_COLOR -> true + | T_HIGHLIGHT -> true + | T_HIDDEN_DATA -> true + | T_HEX -> true + | T_HEIGHT_IN_CELLS -> true + | T_HEAVY -> true + | T_HEADING_FONT -> true + | T_HEADING_DIVIDER_COLOR -> true + | T_HEADING_COLOR -> true + | T_HEADING -> true + | T_HAS_CHILDREN -> true + | T_HANDLE -> true + | T_GT -> true + | T_GROUP_VALUE -> true + | T_GROUP_USAGE -> true + | T_GROUP -> true + | T_GRID -> true + | T_GREATER -> true + | T_GRAPHICAL -> true + | T_GO_SEARCH -> true + | T_GO_HOME -> true + | T_GO_FORWARD -> true + | T_GO_BACK -> true + | T_GOBACK -> true + | T_GO -> true + | T_GLOBAL -> true + | T_GIVING -> true + | T_GET -> true + | T_GENERATE -> true + | T_GE -> true + | T_GCOS -> true + | T_FUNCTION_POINTER -> true + | T_FUNCTION_ID -> true + | T_FUNCTION -> true + | T_FULL_HEIGHT -> true + | T_FULL -> true + | T_FROM -> true + | T_FREE -> true + | T_FRAMED -> true + | T_FRAME -> true + | T_FORMAT -> true + | T_FOREVER -> true + | T_FOREGROUND_COLOR -> true + | T_FOR -> true + | T_FOOTING -> true + | T_FONT -> true + | T_FLR -> true + | T_FLOAT_SHORT -> true + | T_FLOAT_NOT_A_NUMBER_SIGNALING -> true + | T_FLOAT_NOT_A_NUMBER_QUIET -> true + | T_FLOAT_NOT_A_NUMBER -> true + | T_FLOAT_LONG -> true + | T_FLOAT_INFINITY -> true + | T_FLOAT_EXTENDED -> true + | T_FLOAT_DECIMAL_34 -> true + | T_FLOAT_DECIMAL_16 -> true + | T_FLOAT_DECIMAL -> true + | T_FLOAT_BINARY_64 -> true + | T_FLOAT_BINARY_32 -> true + | T_FLOAT_BINARY_128 -> true + | T_FLOAT_BINARY -> true + | T_FLOATING -> true + | T_FLOAT -> true + | T_FLAT_BUTTONS -> true + | T_FLAT -> true + | T_FIXED_WIDTH -> true + | T_FIXED_FONT -> true + | T_FIXED -> true + | T_FIRST -> true + | T_FINISH_REASON -> true + | T_FINALLY -> true + | T_FINAL -> true + | T_FILL_PERCENT -> true + | T_FILL_COLOR2 -> true + | T_FILL_COLOR -> true + | T_FILLER -> true + | T_FILE_POS -> true + | T_FILE_NAME -> true + | T_FILE_LIMITS -> true + | T_FILE_LIMIT -> true + | T_FILE_ID -> true + | T_FILE_CONTROL -> true + | T_FILES -> true + | T_FILE -> true + | T_FH__KEYDEF -> true + | T_FH__FCD -> true + | T_FD -> true + | T_FARTHEST_FROM_ZERO -> true + | T_FALSE -> true + | T_FACTORY -> true + | T_F -> true + | T_EXTERNAL_FORM -> true + | T_EXTERNAL -> true + | T_EXTERN -> true + | T_EXTENDED_SEARCH -> true + | T_EXTEND -> true + | T_EXPANDS -> true + | T_EXPAND -> true + | T_EXIT -> true + | T_EXHIBIT -> true + | T_EXCLUSIVE_OR -> true + | T_EXCLUSIVE -> true + | T_EXCEPTION_VALUE -> true + | T_EXCEPTION_OBJECT -> true + | T_EXCEPTION -> true + | T_EXAMINE -> true + | T_EVERY -> true + | T_EVENT_LIST -> true + | T_EVENT -> true + | T_EVALUATE -> true + | T_ESI -> true + | T_ESCAPE_BUTTON -> true + | T_ESCAPE -> true + | T_ERROR -> true + | T_ERASE -> true + | T_EQUAL -> true + | T_EQ -> true + | T_EOS -> true + | T_EOP -> true + | T_EOL -> true + | T_EO -> true + | T_ENVIRONMENT_VALUE -> true + | T_ENVIRONMENT_NAME -> true + | T_ENVIRONMENT -> true + | T_ENTRY_REASON -> true + | T_ENTRY_FIELD -> true + | T_ENTRY_CONVENTION -> true + | T_ENTRY -> true + | T_ENTER -> true + | T_ENSURE_VISIBLE -> true + | T_ENGRAVED -> true + | T_END_XML -> true + | T_END_WRITE -> true + | T_END_UNSTRING -> true + | T_END_SUBTRACT -> true + | T_END_STRING -> true + | T_END_START -> true + | T_END_SEND -> true + | T_END_SEARCH -> true + | T_END_REWRITE -> true + | T_END_RETURN -> true + | T_END_RECEIVE -> true + | T_END_READ -> true + | T_END_PERFORM -> true + | T_END_OF_PAGE -> true + | T_END_MULTIPLY -> true + | T_END_MODIFY -> true + | T_END_JSON -> true + | T_END_IF -> true + | T_END_EVALUATE -> true + | T_END_DIVIDE -> true + | T_END_DISPLAY -> true + | T_END_DELETE -> true + | T_END_COMPUTE -> true + | T_END_COLOR -> true + | T_END_CHAIN -> true + | T_END_CALL -> true + | T_END_ADD -> true + | T_END_ACCEPT -> true + | T_ENDING -> true + | T_END -> true + | T_ENCRYPTION -> true + | T_ENCODING -> true + | T_ENABLE -> true + | T_EMI -> true + | T_ELSE -> true + | T_ELEMENT -> true + | T_EIGHTY_EIGHT -> true + | T_EGI -> true + | T_EDITING -> true + | T_ECHO -> true + | T_EC -> true + | T_EBCDIC -> true + | T_DYNAMIC -> true + | T_DUPLICATES -> true + | T_DROP_LIST -> true + | T_DROP_DOWN -> true + | T_DRAG_COLOR -> true + | T_DOWN -> true + | T_DOUBLE_COLON -> true + | T_DOUBLE_ASTERISK -> true + | T_DOUBLE -> true + | T_DOTTED -> true + | T_DOTDASH -> true + | T_DIVISION -> true + | T_DIVIDER_COLOR -> true + | T_DIVIDERS -> true + | T_DIVIDE -> true + | T_DISPLAY_FORMAT -> true + | T_DISPLAY_COLUMNS -> true + | T_DISPLAY_4 -> true + | T_DISPLAY_3 -> true + | T_DISPLAY_2 -> true + | T_DISPLAY_1 -> true + | T_DISPLAY -> true + | T_DISP -> true + | T_DISK -> true + | T_DISCONNECT -> true + | T_DISC -> true + | T_DISABLE -> true + | T_DETAIL -> true + | T_DESTROY -> true + | T_DESTINATION -> true + | T_DESCENDING -> true + | T_DEPENDING -> true + | T_DELIMITER -> true + | T_DELIMITED -> true + | T_DELETE -> true + | T_DEFINITION -> true + | T_DEFAULT_FONT -> true + | T_DEFAULT_BUTTON -> true + | T_DEFAULT -> true + | T_DECLARATIVES -> true + | T_DECIMAL_POINT -> true + | T_DECIMAL_ENCODING -> true + | T_DEBUG_SUB_3 -> true + | T_DEBUG_SUB_2 -> true + | T_DEBUG_SUB_1 -> true + | T_DEBUG_NAME -> true + | T_DEBUG_LINE -> true + | T_DEBUG_ITEM -> true + | T_DEBUG_CONTENTS -> true + | T_DEBUGGING -> true + | T_DAY_OF_WEEK -> true + | T_DAY -> true + | T_DATE_ENTRY -> true + | T_DATE -> true + | T_DATA_TYPES -> true + | T_DATA_RECORDS -> true + | T_DATA_RECORD -> true + | T_DATA_POINTER -> true + | T_DATA_COLUMNS -> true + | T_DATA -> true + | T_DASH_SIGN -> true + | T_DASHED -> true + | T_CYL_OVERFLOW -> true + | T_CYL_INDEX -> true + | T_CYCLE -> true + | T_CUSTOM_PRINT_TEMPLATE -> true + | T_CURSOR_Y -> true + | T_CURSOR_X -> true + | T_CURSOR_ROW -> true + | T_CURSOR_FRAME_WIDTH -> true + | T_CURSOR_COLOR -> true + | T_CURSOR_COL -> true + | T_CURSOR -> true + | T_CURRENT -> true + | T_CURRENCY -> true + | T_CS_GENERAL -> true + | T_CS_BASIC -> true + | T_CSIZE -> true + | T_CRT_UNDER -> true + | T_CRT -> true + | T_COUNT -> true + | T_CORRESPONDING -> true + | T_CORE_INDEX -> true + | T_COPY_SELECTION -> true + | T_COPY -> true + | T_CONVERTING -> true + | T_CONVERSION -> true + | T_CONTROLS -> true + | T_CONTROL -> true + | T_CONTINUE -> true + | T_CONTENT -> true + | T_CONTAINS -> true + | T_CONSTANT -> true + | T_CONSOLE_3 -> true + | T_CONSOLE_2 -> true + | T_CONSOLE_1 -> true + | T_CONSOLE_0 -> true + | T_CONNECT -> true + | T_CONFIGURATION -> true + | T_CONDITION -> true + | T_COMP_X -> true + | T_COMP_N -> true + | T_COMP_9 -> true + | T_COMP_7 -> true + | T_COMP_6 -> true + | T_COMP_5 -> true + | T_COMP_4 -> true + | T_COMP_3 -> true + | T_COMP_2 -> true + | T_COMP_15 -> true + | T_COMP_14 -> true + | T_COMP_13 -> true + | T_COMP_12 -> true + | T_COMP_11 -> true + | T_COMP_10 -> true + | T_COMP_1 -> true + | T_COMP_0 -> true + | T_COMPUTE -> true + | T_COMPUTATIONAL_7 -> true + | T_COMPUTATIONAL_14 -> true + | T_COMPUTATIONAL_13 -> true + | T_COMPUTATIONAL_12 -> true + | T_COMPUTATIONAL_11 -> true + | T_COMPLEMENTARY -> true + | T_COMPLE -> true + | T_COMP -> true + | T_COMMUNICATION -> true + | T_COMMON -> true + | T_COMMIT -> true + | T_COMMAND_LINE -> true + | T_COMMA -> true + | T_COMBO_BOX -> true + | T_COLUMN_PROTECTION -> true + | T_COLUMN_HEADINGS -> true + | T_COLUMN_FONT -> true + | T_COLUMN_DIVIDERS -> true + | T_COLUMN_COLOR -> true + | T_COLUMNS -> true + | T_COLUMN -> true + | T_COLORS -> true + | T_COLOR -> true + | T_COLON -> true + | T_COLLATING -> true + | T_COL -> true + | T_CODE_SET -> true + | T_CODE -> true + | T_COBOL -> true + | T_CLOSE -> true + | T_CLOCK_UNITS -> true + | T_CLINES -> true + | T_CLINE -> true + | T_CLEAR_SELECTION -> true + | T_CLASS_ID -> true + | T_CLASSIFICATION -> true + | T_CLASS -> true + | T_CHECK_BOX -> true + | T_CHECKPOINT_FILE -> true + | T_CHECK -> true + | T_CHARACTERS -> true + | T_CHARACTER -> true + | T_CHANGED -> true + | T_CHAINING -> true + | T_CHAIN -> true + | T_CH -> true + | T_CF -> true + | T_CENTURY_DATE -> true + | T_CENTERED_HEADINGS -> true + | T_CENTERED -> true + | T_CENTER -> true + | T_CELL_PROTECTION -> true + | T_CELL_FONT -> true + | T_CELL_DATA -> true + | T_CELL_COLOR -> true + | T_CELL -> true + | T_CD -> true + | T_CCOL -> true + | T_CATALOGUE_NAME -> true + | T_CATALOGUED -> true + | T_CASSETTE -> true + | T_CARD_READER -> true + | T_CARD_PUNCH -> true + | T_CAPACITY -> true + | T_CANCEL_BUTTON -> true + | T_CANCEL -> true + | T_CALL -> true + | T_CALENDAR_FONT -> true + | T_C -> true + | T_B_XOR -> true + | T_B_SHIFT_RC -> true + | T_B_SHIFT_R -> true + | T_B_SHIFT_LC -> true + | T_B_SHIFT_L -> true + | T_B_OR -> true + | T_B_NOT -> true + | T_B_EXOR -> true + | T_B_AND -> true + | T_BYTE_LENGTH -> true + | T_BYTES -> true + | T_BYTE -> true + | T_BY -> true + | T_BUTTONS -> true + | T_BUSY -> true + | T_BULK_ADDITION -> true + | T_BSN -> true + | T_BOXED -> true + | T_BOX -> true + | T_BOTTOM -> true + | T_BOOLEAN -> true + | T_BLOCK -> true + | T_BLINK -> true + | T_BLANK -> true + | T_BITS -> true + | T_BITMAP_WIDTH -> true + | T_BITMAP_TRANSPARENT_COLOR -> true + | T_BITMAP_TRAILING -> true + | T_BITMAP_TIMER -> true + | T_BITMAP_START -> true + | T_BITMAP_NUMBER -> true + | T_BITMAP_HANDLE -> true + | T_BITMAP_END -> true + | T_BITMAP -> true + | T_BIT -> true + | T_BINARY_SHORT -> true + | T_BINARY_SEQUENTIAL -> true + | T_BINARY_LONG -> true + | T_BINARY_ENCODING -> true + | T_BINARY_DOUBLE -> true + | T_BINARY_C_LONG -> true + | T_BINARY_CHAR -> true + | T_BINARY -> true + | T_BELL -> true + | T_BEGINNING -> true + | T_BEFORE -> true + | T_BECOMES -> true + | T_BASED -> true + | T_BAR -> true + | T_BACKWARD -> true + | T_BACKGROUND_STANDARD -> true + | T_BACKGROUND_LOW -> true + | T_BACKGROUND_HIGH -> true + | T_BACKGROUND_COLOR -> true + | T_AWAY_FROM_ZERO -> true + | T_AUTO_SPIN -> true + | T_AUTO_DECIMAL -> true + | T_AUTOMATIC -> true + | T_AUTO -> true + | T_AT_EOP -> true + | T_AT_END -> true + | T_ATTRIBUTES -> true + | T_ATTRIBUTE -> true + | T_AT -> true + | T_ASTERISK -> true + | T_ASSIGN -> true + | T_ASCII -> true + | T_ASCENDING -> true + | T_ASA -> true + | T_AS -> true + | T_ARITHMETIC -> true + | T_ARGUMENT_VALUE -> true + | T_ARGUMENT_NUMBER -> true + | T_AREAS -> true + | T_AREA -> true + | T_ARE -> true + | T_APPLY -> true + | T_ANYCASE -> true + | T_ANY -> true + | T_ANUM -> true + | T_ANSI -> true + | T_AND -> true + | T_AMPERSAND -> true + | T_ALTERNATE -> true + | T_ALTERING -> true + | T_ALTER -> true + | T_ALSO -> true + | T_ALPHANUMERIC_EDITED -> true + | T_ALPHANUMERIC -> true + | T_ALPHABETIC_UPPER -> true + | T_ALPHABETIC_LOWER -> true + | T_ALPHABETIC -> true + | T_ALPHABET -> true + | T_ALLOWING -> true + | T_ALLOCATE -> true + | T_ALL -> true + | T_ALIGNMENT -> true + | T_ALIGNED -> true + | T_ALIAS -> true + | T_AFTER -> true + | T_ADVANCING -> true + | T_ADJUSTABLE_COLUMNS -> true + | T_ADDRESS -> true + | T_ADD -> true + | T_ACTUAL -> true + | T_ACTIVE_X -> true + | T_ACTIVE_CLASS -> true + | T_ACTIVATING -> true + | T_ACTION -> true + | T_ACCESS -> true + | T_ACCEPT -> true + | T_ABSENT -> true + | _ -> false + +let recover = + let r0 = [R 335] in + let r1 = R 1330 :: r0 in + let r2 = S (T T_PERIOD) :: r1 in + let r3 = [R 396] in + let r4 = R 1391 :: r3 in + let r5 = [R 395] in + let r6 = Sub (r4) :: r5 in + let r7 = S (T T_PERIOD) :: r6 in + let r8 = [R 2426] in + let r9 = S (T T_TERMINAL) :: r8 in + let r10 = [R 391] in + let r11 = Sub (r9) :: r10 in + let r12 = [R 917] in + let r13 = S (T T_PERIOD) :: r12 in + let r14 = [R 394] in + let r15 = Sub (r9) :: r14 in + let r16 = [R 287] in + let r17 = S (T T_EOF) :: r16 in + let r18 = R 1379 :: r17 in + let r19 = [R 658] in + let r20 = S (T T_PERIOD) :: r19 in + let r21 = [R 90] in + let r22 = S (N N_ro_pf_AS_string_literal__) :: r21 in + let r23 = [R 602] in + let r24 = S (T T_PERIOD) :: r23 in + let r25 = Sub (r22) :: r24 in + let r26 = S (N N_name) :: r25 in + let r27 = S (T T_PERIOD) :: r26 in + let r28 = S (T T_FUNCTION_ID) :: r27 in + let r29 = [R 615] in + let r30 = S (T T_PERIOD) :: r29 in + let r31 = S (N N_name) :: r30 in + let r32 = S (T T_FUNCTION) :: r31 in + let r33 = S (T T_END) :: r32 in + let r34 = S (N N_ro_procedure_division_) :: r33 in + let r35 = S (N N_ro_loc_data_division__) :: r34 in + let r36 = S (N N_ro_loc_environment_division__) :: r35 in + let r37 = S (N N_ro_options_paragraph_) :: r36 in + let r38 = [R 728] in + let r39 = S (T T_PERIOD) :: r38 in + let r40 = R 881 :: r39 in + let r41 = R 879 :: r40 in + let r42 = Sub (r22) :: r41 in + let r43 = S (N N_name) :: r42 in + let r44 = [R 2152] in + let r45 = S (N N_figurative_constant) :: r44 in + let r46 = [R 1418] in + let r47 = [R 1125] in + let r48 = S (T T_HIGH_VALUE) :: r47 in + let r49 = [R 553] in + let r50 = [R 1126] in + let r51 = [R 2154] in + let r52 = S (T T_ALPHANUM) :: r51 in + let r53 = [R 2153] in + let r54 = Sub (r52) :: r53 in + let r55 = [R 2162] in + let r56 = [R 992] in + let r57 = S (N N_rnel_name_) :: r56 in + let r58 = [R 880] in + let r59 = Sub (r57) :: r58 in + let r60 = [R 882] in + let r61 = [R 603] in + let r62 = S (T T_PERIOD) :: r61 in + let r63 = [R 244] in + let r64 = S (T T_PERIOD) :: r63 in + let r65 = R 873 :: r64 in + let r66 = R 869 :: r65 in + let r67 = R 156 :: r66 in + let r68 = Sub (r22) :: r67 in + let r69 = S (N N_name) :: r68 in + let r70 = [R 157] in + let r71 = [R 870] in + let r72 = Sub (r57) :: r71 in + let r73 = [R 874] in + let r74 = [R 727] in + let r75 = S (T T_PERIOD) :: r74 in + let r76 = S (N N_name) :: r75 in + let r77 = S (T T_INTERFACE) :: r76 in + let r78 = S (T T_END) :: r77 in + let r79 = S (N N_ro_object_procedure_division_) :: r78 in + let r80 = S (N N_ro_loc_environment_division__) :: r79 in + let r81 = [R 1530] in + let r82 = R 899 :: r81 in + let r83 = [R 1937] in + let r84 = S (T T_AWAY_FROM_ZERO) :: r83 in + let r85 = [R 730] in + let r86 = Sub (r84) :: r85 in + let r87 = R 1216 :: r86 in + let r88 = [R 452] in + let r89 = S (T T_BINARY_ENCODING) :: r88 in + let r90 = [R 446] in + let r91 = Sub (r89) :: r90 in + let r92 = [R 589] in + let r93 = Sub (r91) :: r92 in + let r94 = R 1216 :: r93 in + let r95 = [R 468] in + let r96 = S (T T_HIGH_ORDER_LEFT) :: r95 in + let r97 = [R 583] in + let r98 = Sub (r96) :: r97 in + let r99 = R 1216 :: r98 in + let r100 = [R 476] in + let r101 = S (T T_COBOL) :: r100 in + let r102 = [R 1931] in + let r103 = Sub (r84) :: r102 in + let r104 = R 1216 :: r103 in + let r105 = R 1230 :: r104 in + let r106 = [R 66] in + let r107 = S (T T_NATIVE) :: r106 in + let r108 = [R 65] in + let r109 = Sub (r107) :: r108 in + let r110 = [R 900] in + let r111 = [R 479] in + let r112 = S (N N_ro_input_output_section_) :: r111 in + let r113 = S (N N_ro_configuration_section_) :: r112 in + let r114 = S (T T_PERIOD) :: r113 in + let r115 = [R 311] in + let r116 = S (N N_ro_repository_paragraph_) :: r115 in + let r117 = S (N N_ro_special_names_paragraph_) :: r116 in + let r118 = S (N N_ro_object_computer_paragraph_) :: r117 in + let r119 = S (N N_ro_source_computer_paragraph_) :: r118 in + let r120 = S (T T_PERIOD) :: r119 in + let r121 = [R 2072] in + let r122 = R 1242 :: r121 in + let r123 = [R 2073] in + let r124 = S (T T_PERIOD) :: r123 in + let r125 = [R 153] in + let r126 = S (T T_MODE) :: r125 in + let r127 = [R 1145] in + let r128 = R 1242 :: r127 in + let r129 = [R 1146] in + let r130 = S (T T_PERIOD) :: r129 in + let r131 = [R 2003] in + let r132 = S (N N_integer) :: r131 in + let r133 = [R 908] in + let r134 = S (T T_CHARACTERS) :: r133 in + let r135 = [R 906] in + let r136 = Sub (r134) :: r135 in + let r137 = S (N N_integer) :: r136 in + let r138 = [R 51] in + let r139 = S (N N_ro_name_) :: r138 in + let r140 = S (N N_name) :: r139 in + let r141 = R 1216 :: r140 in + let r142 = [R 1576] in + let r143 = Sub (r141) :: r142 in + let r144 = S (T T_SEQUENCE) :: r143 in + let r145 = [R 343] in + let r146 = S (N N_name) :: r145 in + let r147 = R 1216 :: r146 in + let r148 = [R 344] in + let r149 = S (N N_name) :: r148 in + let r150 = R 1216 :: r149 in + let r151 = [R 856] in + let r152 = S (N N_name) :: r151 in + let r153 = [R 206] in + let r154 = S (N N_ro_locale_phrase_) :: r153 in + let r155 = Sub (r152) :: r154 in + let r156 = R 1216 :: r155 in + let r157 = [R 211] in + let r158 = Sub (r156) :: r157 in + let r159 = [R 205] in + let r160 = Sub (r152) :: r159 in + let r161 = R 1216 :: r160 in + let r162 = [R 204] in + let r163 = Sub (r152) :: r162 in + let r164 = R 1216 :: r163 in + let r165 = [R 794] in + let r166 = [R 2094] in + let r167 = R 1242 :: r166 in + let r168 = [R 2211] in + let r169 = S (N N_ro_pf_IN_name__) :: r168 in + let r170 = S (N N_nel___anonymous_16_) :: r169 in + let r171 = R 591 :: r170 in + let r172 = [R 592] in + let r173 = [R 1430] in + let r174 = [R 726] in + let r175 = S (N N_rnel_integer_) :: r174 in + let r176 = [R 997] in + let r177 = Sub (r175) :: r176 in + let r178 = [R 1531] in + let r179 = Sub (r45) :: r178 in + let r180 = R 1216 :: r179 in + let r181 = S (N N_name) :: r180 in + let r182 = [R 990] in + let r183 = S (N N_name) :: r182 in + let r184 = [R 851] in + let r185 = Sub (r183) :: r184 in + let r186 = R 1216 :: r185 in + let r187 = [R 2184] in + let r188 = S (N N_name) :: r187 in + let r189 = [R 434] in + let r190 = Sub (r188) :: r189 in + let r191 = R 1216 :: r190 in + let r192 = S (N N_name) :: r191 in + let r193 = R 1264 :: r192 in + let r194 = [R 2182] in + let r195 = S (T T_PREFIXED) :: r194 in + let r196 = [R 388] in + let r197 = S (T T_COMMA) :: r196 in + let r198 = [R 346] in + let r199 = S (N N_name) :: r198 in + let r200 = [R 345] in + let r201 = S (N N_ro_pf___anonymous_14_string_literal__) :: r200 in + let r202 = Sub (r45) :: r201 in + let r203 = R 1216 :: r202 in + let r204 = [R 1458] in + let r205 = Sub (r45) :: r204 in + let r206 = S (T T_SYMBOL) :: r205 in + let r207 = S (T T_PICTURE_STRING) :: r206 in + let r208 = R 1216 :: r207 in + let r209 = [R 342] in + let r210 = S (N N_name) :: r209 in + let r211 = R 1216 :: r210 in + let r212 = [R 245] in + let r213 = S (N N_ro_pf_IN_name__) :: r212 in + let r214 = S (N N_nel___anonymous_13_) :: r213 in + let r215 = R 1216 :: r214 in + let r216 = R 591 :: r215 in + let r217 = [R 995] in + let r218 = [R 2164] in + let r219 = S (N N_figurative_constant) :: r218 in + let r220 = [R 1446] in + let r221 = [R 2165] in + let r222 = Sub (r52) :: r221 in + let r223 = [R 220] in + let r224 = S (N N_rnel_literal_phrase_) :: r223 in + let r225 = [R 50] in + let r226 = Sub (r224) :: r225 in + let r227 = S (T T_IS) :: r226 in + let r228 = R 591 :: r227 in + let r229 = [R 835] in + let r230 = [R 1075] in + let r231 = [R 972] in + let r232 = S (N N_name) :: r231 in + let r233 = S (T T_IS) :: r232 in + let r234 = [R 971] in + let r235 = [R 2141] in + let r236 = S (N N_name) :: r235 in + let r237 = R 1216 :: r236 in + let r238 = [R 918] in + let r239 = S (N N_name) :: r238 in + let r240 = R 1216 :: r239 in + let r241 = [R 2142] in + let r242 = S (N N_name) :: r241 in + let r243 = R 1216 :: r242 in + let r244 = [R 919] in + let r245 = S (N N_name) :: r244 in + let r246 = R 1216 :: r245 in + let r247 = [R 2093] in + let r248 = [R 1742] in + let r249 = [R 2099] in + let r250 = Sub (r22) :: r249 in + let r251 = [R 2098] in + let r252 = Sub (r22) :: r251 in + let r253 = [R 729] in + let r254 = S (N N_ro_expands_phrase_) :: r253 in + let r255 = Sub (r22) :: r254 in + let r256 = [R 494] in + let r257 = Sub (r57) :: r256 in + let r258 = S (T T_USING) :: r257 in + let r259 = [R 614] in + let r260 = S (T T_INTRINSIC) :: r259 in + let r261 = [R 613] in + let r262 = [R 612] in + let r263 = [R 246] in + let r264 = S (N N_ro_expands_phrase_) :: r263 in + let r265 = Sub (r22) :: r264 in + let r266 = [R 1743] in + let r267 = [R 714] in + let r268 = S (N N_ro_io_control_paragraph_) :: r267 in + let r269 = S (N N_ro_file_control_paragraph_) :: r268 in + let r270 = S (T T_PERIOD) :: r269 in + let r271 = [R 554] in + let r272 = S (N N_rl_select_) :: r271 in + let r273 = [R 2004] in + let r274 = S (T T_PERIOD) :: r273 in + let r275 = S (N N_rnel_loc_select_clause__) :: r274 in + let r276 = S (N N_name) :: r275 in + let r277 = [R 2050] in + let r278 = R 1240 :: r277 in + let r279 = S (T T_ALL) :: r278 in + let r280 = [R 2049] in + let r281 = Sub (r279) :: r280 in + let r282 = [R 2052] in + let r283 = [R 2051] in + let r284 = [R 1750] in + let r285 = R 1403 :: r284 in + let r286 = [R 1651] in + let r287 = S (N N_name) :: r286 in + let r288 = R 1216 :: r287 in + let r289 = [R 1648] in + let r290 = R 895 :: r289 in + let r291 = S (N N_qualname) :: r290 in + let r292 = R 1216 :: r291 in + let r293 = [R 1646] in + let r294 = S (T T_STANDARD_1) :: r293 in + let r295 = [R 1647] in + let r296 = Sub (r294) :: r295 in + let r297 = [R 896] in + let r298 = Sub (r57) :: r297 in + let r299 = [R 1601] in + let r300 = [R 1602] in + let r301 = S (N N_qualname) :: r300 in + let r302 = [R 1539] in + let r303 = Sub (r301) :: r302 in + let r304 = R 1216 :: r303 in + let r305 = [R 1532] in + let r306 = S (T T_INDEXED) :: r305 in + let r307 = [R 1536] in + let r308 = Sub (r306) :: r307 in + let r309 = [R 1534] in + let r310 = [R 864] in + let r311 = S (T T_AUTOMATIC) :: r310 in + let r312 = [R 865] in + let r313 = S (N N_with_lock_clause) :: r312 in + let r314 = Sub (r311) :: r313 in + let r315 = R 1216 :: r314 in + let r316 = [R 2419] in + let r317 = S (T T_RECORD) :: r316 in + let r318 = R 126 :: r317 in + let r319 = S (T T_ON) :: r318 in + let r320 = [R 92] in + let r321 = S (N N_name) :: r320 in + let r322 = [R 91] in + let r323 = S (N N_ro_pf_USING_name__) :: r322 in + let r324 = S (N N_rnel_name_or_alphanum_) :: r323 in + let r325 = [R 1450] in + let r326 = [R 56] in + let r327 = R 154 :: r326 in + let r328 = R 893 :: r327 in + let r329 = S (N N_qualname) :: r328 in + let r330 = R 1216 :: r329 in + let r331 = R 1218 :: r330 in + let r332 = [R 894] in + let r333 = Sub (r57) :: r332 in + let r334 = [R 155] in + let r335 = [R 18] in + let r336 = S (T T_DYNAMIC) :: r335 in + let r337 = [R 21] in + let r338 = Sub (r336) :: r337 in + let r339 = R 1216 :: r338 in + let r340 = [R 569] in + let r341 = S (N N_qualname) :: r340 in + let r342 = R 1216 :: r341 in + let r343 = [R 256] in + let r344 = S (N N_ntl_name_) :: r343 in + let r345 = S (T T_OF) :: r344 in + let r346 = [R 255] in + let r347 = S (N N_name) :: r346 in + let r348 = [R 1135] in + let r349 = [R 822] in + let r350 = [R 739] in + let r351 = R 1352 :: r350 in + let r352 = [R 1749] in + let r353 = S (N N_name) :: r352 in + let r354 = [R 1744] in + let r355 = Sub (r353) :: r354 in + let r356 = R 1202 :: r355 in + let r357 = [R 1436] in + let r358 = [R 1745] in + let r359 = S (N N_name) :: r358 in + let r360 = R 1234 :: r359 in + let r361 = S (T T_REEL) :: r360 in + let r362 = [R 1746] in + let r363 = S (N N_name) :: r362 in + let r364 = [R 1748] in + let r365 = [R 1747] in + let r366 = S (N N_name) :: r365 in + let r367 = [R 738] in + let r368 = S (T T_PERIOD) :: r367 in + let r369 = S (N N_rl_loc_multiple_file_clause__) :: r368 in + let r370 = [R 1947] in + let r371 = Sub (r57) :: r370 in + let r372 = S (N N_name) :: r371 in + let r373 = R 1206 :: r372 in + let r374 = R 1182 :: r373 in + let r375 = [R 806] in + let r376 = [R 977] in + let r377 = S (N N_nel___anonymous_21_) :: r376 in + let r378 = R 1194 :: r377 in + let r379 = R 1268 :: r378 in + let r380 = [R 999] in + let r381 = [R 1438] in + let r382 = [R 792] in + let r383 = [R 804] in + let r384 = [R 1148] in + let r385 = S (N N_rl_loc_method_definition__) :: r384 in + let r386 = S (T T_PERIOD) :: r385 in + let r387 = [R 914] in + let r388 = R 146 :: r387 in + let r389 = R 134 :: r388 in + let r390 = Sub (r22) :: r389 in + let r391 = S (N N_name) :: r390 in + let r392 = S (T T_PERIOD) :: r391 in + let r393 = S (T T_METHOD_ID) :: r392 in + let r394 = [R 913] in + let r395 = S (T T_PERIOD) :: r394 in + let r396 = S (N N_name) :: r395 in + let r397 = S (T T_METHOD) :: r396 in + let r398 = S (T T_END) :: r397 in + let r399 = S (N N_ro_procedure_division_) :: r398 in + let r400 = S (N N_ro_loc_data_division__) :: r399 in + let r401 = S (N N_ro_loc_environment_division__) :: r400 in + let r402 = S (N N_ro_options_paragraph_) :: r401 in + let r403 = [R 916] in + let r404 = R 150 :: r403 in + let r405 = R 134 :: r404 in + let r406 = S (N N_name) :: r405 in + let r407 = [R 151] in + let r408 = [R 915] in + let r409 = R 150 :: r408 in + let r410 = R 134 :: r409 in + let r411 = S (N N_name) :: r410 in + let r412 = [R 147] in + let r413 = [R 373] in + let r414 = S (N N_ro_screen_section_) :: r413 in + let r415 = S (N N_ro_report_section_) :: r414 in + let r416 = S (N N_ro_communication_section_) :: r415 in + let r417 = S (N N_ro_linkage_section_) :: r416 in + let r418 = S (N N_ro_local_storage_section_) :: r417 in + let r419 = S (N N_ro_working_storage_section_) :: r418 in + let r420 = S (N N_ro_file_section_) :: r419 in + let r421 = S (T T_PERIOD) :: r420 in + let r422 = [R 568] in + let r423 = S (N N_rl_loc_file_or_sort_merge_descr_entry__) :: r422 in + let r424 = S (T T_PERIOD) :: r423 in + let r425 = [R 567] in + let r426 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r425 in + let r427 = S (T T_PERIOD) :: r426 in + let r428 = S (N N_rl_loc_sort_merge_file_descr_clause__) :: r427 in + let r429 = [R 1643] in + let r430 = R 1190 :: r429 in + let r431 = S (N N_integer) :: r430 in + let r432 = [R 598] in + let r433 = R 1190 :: r432 in + let r434 = [R 1645] in + let r435 = S (N N_ro_depending_phrase_) :: r434 in + let r436 = Sub (r433) :: r435 in + let r437 = R 1260 :: r436 in + let r438 = R 1210 :: r437 in + let r439 = [R 600] in + let r440 = R 1190 :: r439 in + let r441 = [R 599] in + let r442 = R 1190 :: r441 in + let r443 = [R 601] in + let r444 = R 1190 :: r443 in + let r445 = [R 405] in + let r446 = S (N N_qualname) :: r445 in + let r447 = R 1236 :: r446 in + let r448 = [R 1644] in + let r449 = R 1190 :: r448 in + let r450 = [R 348] in + let r451 = Sub (r57) :: r450 in + let r452 = [R 347] in + let r453 = Sub (r57) :: r452 in + let r454 = [R 814] in + let r455 = [R 372] in + let r456 = S (T T_PERIOD) :: r455 in + let r457 = S (N N_rl_loc_data_descr_clause__) :: r456 in + let r458 = [R 2402] in + let r459 = [R 1003] in + let r460 = S (N N_ro_pf_BY_expression__) :: r459 in + let r461 = [R 1424] in + let r462 = [R 526] in + let r463 = [R 340] in + let r464 = [R 99] in + let r465 = S (T T_RPAR) :: r464 in + let r466 = S (N N_expression) :: r465 in + let r467 = [R 341] in + let r468 = [R 339] in + let r469 = [R 608] in + let r470 = [R 604] in + let r471 = [R 605] in + let r472 = S (T T_RPAR) :: r471 in + let r473 = S (N N_ro_expression_no_all_) :: r472 in + let r474 = S (T T_COLON) :: r473 in + let r475 = [R 502] in + let r476 = [R 101] in + let r477 = S (T T_RPAR) :: r476 in + let r478 = [R 503] in + let r479 = [R 38] in + let r480 = S (N N_ident) :: r479 in + let r481 = [R 39] in + let r482 = [R 2192] in + let r483 = S (T T_RPAR) :: r482 in + let r484 = [R 504] in + let r485 = [R 1152] in + let r486 = [R 711] in + let r487 = R 1521 :: r486 in + let r488 = [R 831] in + let r489 = Sub (r48) :: r488 in + let r490 = [R 1522] in + let r491 = [R 1523] in + let r492 = [R 501] in + let r493 = S (N N_atomic_expression_no_all) :: r492 in + let r494 = [R 518] in + let r495 = Sub (r493) :: r494 in + let r496 = [R 532] in + let r497 = [R 514] in + let r498 = [R 497] in + let r499 = [R 517] in + let r500 = [R 516] in + let r501 = [R 515] in + let r502 = [R 513] in + let r503 = [R 533] in + let r504 = [R 1156] in + let r505 = [R 1158] in + let r506 = S (N N_name) :: r505 in + let r507 = [R 500] in + let r508 = [R 2055] in + let r509 = S (T T_NEGATIVE) :: r508 in + let r510 = [R 2190] in + let r511 = S (N N_integer) :: r510 in + let r512 = [R 525] in + let r513 = S (N N_atomic_expression) :: r512 in + let r514 = [R 496] in + let r515 = Sub (r513) :: r514 in + let r516 = [R 512] in + let r517 = Sub (r515) :: r516 in + let r518 = [R 535] in + let r519 = [R 527] in + let r520 = [R 528] in + let r521 = [R 495] in + let r522 = [R 508] in + let r523 = [R 511] in + let r524 = [R 510] in + let r525 = [R 509] in + let r526 = [R 507] in + let r527 = [R 536] in + let r528 = [R 520] in + let r529 = [R 523] in + let r530 = [R 522] in + let r531 = [R 521] in + let r532 = [R 519] in + let r533 = [R 505] in + let r534 = [R 2191] in + let r535 = [R 2187] in + let r536 = S (N N_integer) :: r535 in + let r537 = [R 1595] in + let r538 = S (T T_RPAR) :: r537 in + let r539 = S (N N_ro_expression_no_all_) :: r538 in + let r540 = [R 1596] in + let r541 = S (T T_RPAR) :: r540 in + let r542 = S (N N_ro_expression_no_all_) :: r541 in + let r543 = S (T T_COLON) :: r542 in + let r544 = [R 499] in + let r545 = [R 498] in + let r546 = [R 606] in + let r547 = [R 607] in + let r548 = S (T T_RPAR) :: r547 in + let r549 = S (N N_ro_expression_no_all_) :: r548 in + let r550 = S (T T_COLON) :: r549 in + let r551 = [R 609] in + let r552 = S (T T_RPAR) :: r551 in + let r553 = S (N N_ro_expression_no_all_) :: r552 in + let r554 = [R 529] in + let r555 = [R 530] in + let r556 = [R 1420] in + let r557 = [R 379] in + let r558 = S (N N_literal) :: r557 in + let r559 = [R 1007] in + let r560 = R 871 :: r559 in + let r561 = S (N N_subscripts) :: r560 in + let r562 = [R 872] in + let r563 = [R 378] in + let r564 = S (N N_literal) :: r563 in + let r565 = [R 482] in + let r566 = S (T T_ERROR) :: r565 in + let r567 = [R 2390] in + let r568 = S (N N_idents) :: r567 in + let r569 = S (T T_FOR) :: r568 in + let r570 = R 887 :: r569 in + let r571 = Sub (r566) :: r570 in + let r572 = R 1280 :: r571 in + let r573 = S (N N_ident_or_literal) :: r572 in + let r574 = [R 483] in + let r575 = [R 888] in + let r576 = [R 2320] in + let r577 = S (T T_BINARY) :: r576 in + let r578 = [R 2355] in + let r579 = Sub (r577) :: r578 in + let r580 = [R 2341] in + let r581 = [R 1481] in + let r582 = [R 2340] in + let r583 = [R 2338] in + let r584 = S (N N_ro_object_reference_kind_) :: r583 in + let r585 = [R 165] in + let r586 = [R 1155] in + let r587 = R 130 :: r586 in + let r588 = [R 1154] in + let r589 = [R 2339] in + let r590 = S (N N_name) :: r589 in + let r591 = [R 2336] in + let r592 = [R 2335] in + let r593 = [R 470] in + let r594 = S (N N_ro_endianness_mode_) :: r593 in + let r595 = [R 2333] in + let r596 = [R 2332] in + let r597 = [R 2334] in + let r598 = [R 2061] in + let r599 = S (N N_ro_signedness_) :: r598 in + let r600 = [R 2326] in + let r601 = [R 2327] in + let r602 = [R 2328] in + let r603 = [R 2325] in + let r604 = [R 2222] in + let r605 = [R 377] in + let r606 = S (N N_name) :: r605 in + let r607 = [R 1293] in + let r608 = [R 2018] in + let r609 = S (N N_name) :: r608 in + let r610 = [R 1948] in + let r611 = S (N N_name) :: r610 in + let r612 = [R 1649] in + let r613 = [R 1589] in + let r614 = R 160 :: r613 in + let r615 = [R 161] in + let r616 = [R 1474] in + let r617 = S (T T_GET) :: r616 in + let r618 = [R 1127] in + let r619 = S (N N_expression) :: r618 in + let r620 = [R 293] in + let r621 = Sub (r619) :: r620 in + let r622 = [R 310] in + let r623 = Sub (r621) :: r622 in + let r624 = [R 1567] in + let r625 = Sub (r623) :: r624 in + let r626 = [R 1128] in + let r627 = [R 1132] in + let r628 = S (T T_RPAR) :: r627 in + let r629 = [R 1131] in + let r630 = S (T T_RPAR) :: r629 in + let r631 = [R 572] in + let r632 = S (N N_expression) :: r631 in + let r633 = [R 296] in + let r634 = [R 574] in + let r635 = [R 580] in + let r636 = S (T T_RPAR) :: r635 in + let r637 = [R 1662] in + let r638 = [R 1690] in + let r639 = R 1278 :: r638 in + let r640 = [R 1658] in + let r641 = [R 1654] in + let r642 = [R 1682] in + let r643 = R 1278 :: r642 in + let r644 = [R 1670] in + let r645 = [R 1661] in + let r646 = [R 1689] in + let r647 = R 1278 :: r646 in + let r648 = [R 543] in + let r649 = S (T T_OMITTED) :: r648 in + let r650 = [R 1659] in + let r651 = [R 1664] in + let r652 = [R 1692] in + let r653 = R 1278 :: r652 in + let r654 = [R 1660] in + let r655 = [R 1656] in + let r656 = [R 1684] in + let r657 = R 1278 :: r656 in + let r658 = [R 1672] in + let r659 = [R 1663] in + let r660 = [R 1691] in + let r661 = R 1278 :: r660 in + let r662 = [R 1655] in + let r663 = [R 1683] in + let r664 = R 1278 :: r663 in + let r665 = [R 1671] in + let r666 = [R 1653] in + let r667 = [R 1681] in + let r668 = R 1278 :: r667 in + let r669 = [R 1669] in + let r670 = [R 1650] in + let r671 = [R 542] in + let r672 = [R 301] in + let r673 = [R 300] in + let r674 = [R 579] in + let r675 = S (T T_RPAR) :: r674 in + let r676 = [R 573] in + let r677 = [R 582] in + let r678 = [R 581] in + let r679 = [R 295] in + let r680 = [R 299] in + let r681 = [R 298] in + let r682 = [R 1559] in + let r683 = S (N N_ro_depending_phrase_) :: r682 in + let r684 = S (N N_ro_picture_locale_phrase_) :: r683 in + let r685 = S (T T_PICTURE_STRING) :: r684 in + let r686 = [R 1560] in + let r687 = S (N N_integer) :: r686 in + let r688 = R 1216 :: r687 in + let r689 = S (T T_SIZE) :: r688 in + let r690 = [R 1479] in + let r691 = [R 1163] in + let r692 = R 885 :: r691 in + let r693 = S (N N_rl_key_is_) :: r692 in + let r694 = R 1276 :: r693 in + let r695 = [R 1162] in + let r696 = R 885 :: r695 in + let r697 = S (N N_rl_key_is_) :: r696 in + let r698 = R 122 :: r697 in + let r699 = S (N N_ro_pf_TO_integer__) :: r698 in + let r700 = S (N N_ro_pf_FROM_integer__) :: r699 in + let r701 = [R 201] in + let r702 = S (N N_name) :: r701 in + let r703 = [R 1428] in + let r704 = [R 1448] in + let r705 = [R 1609] in + let r706 = S (N N_rnel_qualname_) :: r705 in + let r707 = [R 742] in + let r708 = Sub (r706) :: r707 in + let r709 = R 1216 :: r708 in + let r710 = [R 741] in + let r711 = Sub (r706) :: r710 in + let r712 = R 1216 :: r711 in + let r713 = [R 672] in + let r714 = Sub (r57) :: r713 in + let r715 = [R 770] in + let r716 = S (T T_DEPENDING) :: r447 in + let r717 = [R 1161] in + let r718 = R 885 :: r717 in + let r719 = S (N N_rl_key_is_) :: r718 in + let r720 = Sub (r716) :: r719 in + let r721 = R 1276 :: r720 in + let r722 = [R 740] in + let r723 = [R 2223] in + let r724 = [R 545] in + let r725 = [R 1005] in + let r726 = Sub (r623) :: r725 in + let r727 = [R 624] in + let r728 = S (T T_BIT) :: r727 in + let r729 = [R 544] in + let r730 = [R 433] in + let r731 = S (N N_ro_pf___anonymous_43_integer__) :: r730 in + let r732 = S (N N_ro_name_) :: r731 in + let r733 = [R 1472] in + let r734 = S (N N_integer) :: r733 in + let r735 = [R 406] in + let r736 = S (N N_idents) :: r735 in + let r737 = [R 392] in + let r738 = S (N N_ident_or_literal) :: r737 in + let r739 = [R 324] in + let r740 = [R 327] in + let r741 = [R 325] in + let r742 = S (N N_expression) :: r741 in + let r743 = S (T T_AS) :: r742 in + let r744 = [R 313] in + let r745 = S (T T_PERIOD) :: r744 in + let r746 = [R 326] in + let r747 = S (N N_name) :: r746 in + let r748 = [R 312] in + let r749 = S (T T_PERIOD) :: r748 in + let r750 = [R 226] in + let r751 = S (N N_name) :: r750 in + let r752 = [R 227] in + let r753 = Sub (r751) :: r752 in + let r754 = [R 105] in + let r755 = S (T T_ZERO) :: r754 in + let r756 = R 1280 :: r755 in + let r757 = [R 58] in + let r758 = [R 926] in + let r759 = S (T T_LEADING) :: r758 in + let r760 = [R 2056] in + let r761 = R 158 :: r760 in + let r762 = [R 159] in + let r763 = [R 782] in + let r764 = [R 317] in + let r765 = S (T T_PERIOD) :: r764 in + let r766 = R 1286 :: r765 in + let r767 = S (N N_qualname) :: r766 in + let r768 = [R 1287] in + let r769 = [R 776] in + let r770 = [R 318] in + let r771 = S (T T_PERIOD) :: r770 in + let r772 = R 1290 :: r771 in + let r773 = R 1288 :: r772 in + let r774 = S (N N_rnel_literal_through_literal_) :: r773 in + let r775 = R 1216 :: r774 in + let r776 = S (T T_VALUE) :: r775 in + let r777 = [R 319] in + let r778 = S (T T_PERIOD) :: r777 in + let r779 = R 1290 :: r778 in + let r780 = R 1288 :: r779 in + let r781 = S (N N_rnel_literal_through_literal_) :: r780 in + let r782 = [R 1289] in + let r783 = [R 1291] in + let r784 = S (N N_literal) :: r783 in + let r785 = R 1216 :: r784 in + let r786 = S (T T_FALSE) :: r785 in + let r787 = R 1278 :: r786 in + let r788 = [R 838] in + let r789 = [R 566] in + let r790 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r789 in + let r791 = S (T T_PERIOD) :: r790 in + let r792 = S (N N_rl_loc_file_descr_clause__) :: r791 in + let r793 = [R 2401] in + let r794 = S (N N_nel___anonymous_29_) :: r793 in + let r795 = [R 1608] in + let r796 = S (N N_literal) :: r795 in + let r797 = [R 1001] in + let r798 = Sub (r796) :: r797 in + let r799 = [R 1702] in + let r800 = Sub (r57) :: r799 in + let r801 = [R 1701] in + let r802 = Sub (r57) :: r801 in + let r803 = [R 1606] in + let r804 = S (N N_integer) :: r803 in + let r805 = [R 755] in + let r806 = Sub (r804) :: r805 in + let r807 = [R 920] in + let r808 = R 1216 :: r807 in + let r809 = S (T T_RECORD) :: r808 in + let r810 = [R 749] in + let r811 = S (T T_STANDARD) :: r810 in + let r812 = [R 921] in + let r813 = [R 750] in + let r814 = [R 594] in + let r815 = R 1196 :: r814 in + let r816 = [R 596] in + let r817 = [R 595] in + let r818 = [R 253] in + let r819 = [R 106] in + let r820 = S (N N_integer) :: r819 in + let r821 = [R 109] in + let r822 = [R 753] in + let r823 = S (N N_ro_pf___anonymous_32_qualname_or_integer__) :: r822 in + let r824 = [R 754] in + let r825 = S (N N_ro_pf___anonymous_32_qualname_or_integer__) :: r824 in + let r826 = Sub (r804) :: r825 in + let r827 = S (T T_TOP) :: r826 in + let r828 = [R 1462] in + let r829 = Sub (r804) :: r828 in + let r830 = S (T T_BOTTOM) :: r829 in + let r831 = [R 1460] in + let r832 = Sub (r804) :: r831 in + let r833 = R 1184 :: r832 in + let r834 = [R 786] in + let r835 = [R 788] in + let r836 = [R 2427] in + let r837 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r836 in + let r838 = S (T T_PERIOD) :: r837 in + let r839 = [R 843] in + let r840 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r839 in + let r841 = S (T T_PERIOD) :: r840 in + let r842 = [R 766] in + let r843 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r842 in + let r844 = S (T T_PERIOD) :: r843 in + let r845 = [R 286] in + let r846 = S (N N_rl_loc_communication_descr_entry__) :: r845 in + let r847 = S (T T_PERIOD) :: r846 in + let r848 = [R 285] in + let r849 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r848 in + let r850 = S (T T_PERIOD) :: r849 in + let r851 = S (N N_rl_loc_communication_descr_clause__) :: r850 in + let r852 = S (T T_OUTPUT) :: r851 in + let r853 = R 1206 :: r852 in + let r854 = [R 279] in + let r855 = S (N N_name) :: r854 in + let r856 = R 1216 :: r855 in + let r857 = [R 273] in + let r858 = S (N N_name) :: r857 in + let r859 = R 1216 :: r858 in + let r860 = [R 280] in + let r861 = S (N N_name) :: r860 in + let r862 = R 1216 :: r861 in + let r863 = [R 277] in + let r864 = S (N N_name) :: r863 in + let r865 = R 1216 :: r864 in + let r866 = [R 278] in + let r867 = S (N N_name) :: r866 in + let r868 = [R 282] in + let r869 = S (N N_name) :: r868 in + let r870 = R 1216 :: r869 in + let r871 = [R 281] in + let r872 = S (N N_name) :: r871 in + let r873 = R 1216 :: r872 in + let r874 = [R 272] in + let r875 = S (N N_name) :: r874 in + let r876 = [R 275] in + let r877 = R 897 :: r876 in + let r878 = R 1276 :: r877 in + let r879 = S (N N_integer) :: r878 in + let r880 = [R 898] in + let r881 = S (N N_nel_name_) :: r880 in + let r882 = [R 274] in + let r883 = S (N N_name) :: r882 in + let r884 = [R 266] in + let r885 = S (N N_name) :: r884 in + let r886 = R 1216 :: r885 in + let r887 = [R 271] in + let r888 = S (N N_name) :: r887 in + let r889 = [R 269] in + let r890 = S (N N_name) :: r889 in + let r891 = [R 268] in + let r892 = S (N N_name) :: r891 in + let r893 = [R 267] in + let r894 = S (N N_name) :: r893 in + let r895 = [R 270] in + let r896 = S (N N_name) :: r895 in + let r897 = [R 276] in + let r898 = S (N N_name) :: r897 in + let r899 = R 1216 :: r898 in + let r900 = [R 772] in + let r901 = [R 283] in + let r902 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r901 in + let r903 = S (T T_PERIOD) :: r902 in + let r904 = S (N N_rl_loc_entry_name_clause__) :: r903 in + let r905 = S (N N_rl_loc_communication_descr_clause__) :: r904 in + let r906 = [R 284] in + let r907 = S (N N_rl_loc_constant_or_data_descr_entry__) :: r906 in + let r908 = S (T T_PERIOD) :: r907 in + let r909 = S (N N_rl_name_) :: r908 in + let r910 = [R 818] in + let r911 = [R 784] in + let r912 = [R 774] in + let r913 = [R 1733] in + let r914 = S (N N_rl_loc_report_descr_entry__) :: r913 in + let r915 = S (T T_PERIOD) :: r914 in + let r916 = [R 1710] in + let r917 = S (N N_rl_loc_constant_or_report_group_descr_entry__) :: r916 in + let r918 = S (T T_PERIOD) :: r917 in + let r919 = S (N N_rl_loc_report_descr_clause__) :: r918 in + let r920 = [R 1542] in + let r921 = S (T T_COLUMNS) :: r920 in + let r922 = S (N N_integer) :: r921 in + let r923 = [R 1540] in + let r924 = S (N N_ro_pf___anonymous_38_integer__) :: r923 in + let r925 = S (N N_ro_pf___anonymous_37_integer__) :: r924 in + let r926 = S (N N_ro_pf___anonymous_34_integer__) :: r925 in + let r927 = S (N N_ro_pf___anonymous_33_integer__) :: r926 in + let r928 = Sub (r922) :: r927 in + let r929 = [R 1358] in + let r930 = [R 1357] in + let r931 = [R 1464] in + let r932 = S (N N_integer) :: r931 in + let r933 = [R 1466] in + let r934 = S (N N_integer) :: r933 in + let r935 = R 1216 :: r934 in + let r936 = [R 1468] in + let r937 = S (N N_integer) :: r936 in + let r938 = R 1216 :: r937 in + let r939 = [R 925] in + let r940 = [R 1541] in + let r941 = S (N N_ro_pf___anonymous_38_integer__) :: r940 in + let r942 = S (N N_ro_pf___anonymous_37_integer__) :: r941 in + let r943 = S (N N_integer) :: r942 in + let r944 = [R 1470] in + let r945 = S (N N_integer) :: r944 in + let r946 = [R 1545] in + let r947 = [R 1544] in + let r948 = [R 332] in + let r949 = Sub (r57) :: r948 in + let r950 = [R 334] in + let r951 = [R 331] in + let r952 = Sub (r57) :: r951 in + let r953 = [R 333] in + let r954 = [R 252] in + let r955 = S (N N_ident) :: r954 in + let r956 = [R 1727] in + let r957 = S (T T_PERIOD) :: r956 in + let r958 = S (N N_rl_loc_report_group_descr_clause__) :: r957 in + let r959 = [R 946] in + let r960 = [R 945] in + let r961 = [R 1731] in + let r962 = S (T T_DISPLAY) :: r961 in + let r963 = [R 1734] in + let r964 = S (T T_DETAIL) :: r963 in + let r965 = [R 929] in + let r966 = [R 933] in + let r967 = [R 937] in + let r968 = [R 1740] in + let r969 = [R 1704] in + let r970 = S (N N_qualident) :: r969 in + let r971 = [R 1300] in + let r972 = [R 1301] in + let r973 = [R 1739] in + let r974 = [R 1296] in + let r975 = R 166 :: r974 in + let r976 = [R 167] in + let r977 = [R 1297] in + let r978 = R 166 :: r977 in + let r979 = [R 1295] in + let r980 = [R 2207] in + let r981 = S (N N_expression) :: r980 in + let r982 = [R 2209] in + let r983 = R 889 :: r982 in + let r984 = Sub (r981) :: r983 in + let r985 = [R 890] in + let r986 = [R 1134] in + let r987 = [R 944] in + let r988 = [R 943] in + let r989 = [R 1729] in + let r990 = S (N N_ro_step_phrase_) :: r989 in + let r991 = S (N N_ro_depending_phrase_) :: r990 in + let r992 = R 1276 :: r991 in + let r993 = [R 1730] in + let r994 = S (N N_ro_step_phrase_) :: r993 in + let r995 = S (N N_ro_depending_phrase_) :: r994 in + let r996 = R 1276 :: r995 in + let r997 = [R 2144] in + let r998 = [R 1113] in + let r999 = S (N N_integer) :: r998 in + let r1000 = R 1216 :: r999 in + let r1001 = [R 1115] in + let r1002 = [R 1114] in + let r1003 = [R 1116] in + let r1004 = R 168 :: r1003 in + let r1005 = [R 169] in + let r1006 = [R 758] in + let r1007 = [R 942] in + let r1008 = R 1406 :: r1007 in + let r1009 = [R 757] in + let r1010 = [R 941] in + let r1011 = [R 940] in + let r1012 = [R 623] in + let r1013 = [R 45] in + let r1014 = R 1220 :: r1013 in + let r1015 = [R 260] in + let r1016 = [R 259] in + let r1017 = Sub (r1014) :: r1016 in + let r1018 = [R 258] in + let r1019 = Sub (r1014) :: r1018 in + let r1020 = [R 802] in + let r1021 = [R 2205] in + let r1022 = [R 1934] in + let r1023 = Sub (r84) :: r1022 in + let r1024 = [R 2206] in + let r1025 = R 1935 :: r1024 in + let r1026 = Sub (r970) :: r1025 in + let r1027 = [R 1741] in + let r1028 = [R 2079] in + let r1029 = S (N N_expression) :: r1028 in + let r1030 = [R 2071] in + let r1031 = R 1935 :: r1030 in + let r1032 = [R 1728] in + let r1033 = [R 764] in + let r1034 = [R 763] in + let r1035 = [R 765] in + let r1036 = [R 762] in + let r1037 = [R 1703] in + let r1038 = S (N N_rnel_column_position_) :: r1037 in + let r1039 = [R 265] in + let r1040 = [R 264] in + let r1041 = [R 778] in + let r1042 = [R 798] in + let r1043 = [R 800] in + let r1044 = [R 1989] in + let r1045 = S (N N_rl_loc_constant_or_screen_descr_entry__) :: r1044 in + let r1046 = S (T T_PERIOD) :: r1045 in + let r1047 = [R 1984] in + let r1048 = S (T T_PERIOD) :: r1047 in + let r1049 = S (N N_rl_loc_screen_descr_clause__) :: r1048 in + let r1050 = [R 2077] in + let r1051 = S (N N_literal) :: r1050 in + let r1052 = [R 2076] in + let r1053 = [R 2075] in + let r1054 = [R 1988] in + let r1055 = R 1276 :: r1054 in + let r1056 = [R 641] in + let r1057 = S (N N_ident) :: r1056 in + let r1058 = [R 1986] in + let r1059 = Sub (r1057) :: r1058 in + let r1060 = [R 1985] in + let r1061 = Sub (r1059) :: r1060 in + let r1062 = R 1216 :: r1061 in + let r1063 = [R 1987] in + let r1064 = [R 2074] in + let r1065 = [R 1955] in + let r1066 = Sub (r1057) :: r1065 in + let r1067 = [R 951] in + let r1068 = S (T T_EOL) :: r1067 in + let r1069 = [R 480] in + let r1070 = [R 952] in + let r1071 = S (T T_LINE) :: r1070 in + let r1072 = [R 1966] in + let r1073 = Sub (r1059) :: r1072 in + let r1074 = R 1216 :: r1073 in + let r1075 = [R 1965] in + let r1076 = Sub (r1059) :: r1075 in + let r1077 = R 1216 :: r1076 in + let r1078 = [R 1956] in + let r1079 = Sub (r1057) :: r1078 in + let r1080 = [R 808] in + let r1081 = [R 780] in + let r1082 = [R 1568] in + let r1083 = S (N N_rl_loc_section_paragraph__) :: r1082 in + let r1084 = R 883 :: r1083 in + let r1085 = S (T T_PERIOD) :: r1084 in + let r1086 = S (N N_ro_returning_) :: r1085 in + let r1087 = [R 1570] in + let r1088 = S (N N_rl_loc_section_paragraph__) :: r1087 in + let r1089 = R 883 :: r1088 in + let r1090 = S (T T_PERIOD) :: r1089 in + let r1091 = S (N N_ro_returning_) :: r1090 in + let r1092 = [R 1100] in + let r1093 = [R 1099] in + let r1094 = S (N N_name) :: r1093 in + let r1095 = [R 2387] in + let r1096 = Sub (r1094) :: r1095 in + let r1097 = [R 1107] in + let r1098 = S (N N_name) :: r1097 in + let r1099 = [R 2388] in + let r1100 = [R 1102] in + let r1101 = [R 1760] in + let r1102 = S (N N_ident) :: r1101 in + let r1103 = [R 1616] in + let r1104 = [R 171] in + let r1105 = [R 1041] in + let r1106 = [R 390] in + let r1107 = S (T T_PERIOD) :: r1106 in + let r1108 = S (T T_DECLARATIVES) :: r1107 in + let r1109 = S (T T_END) :: r1108 in + let r1110 = S (N N_rnel_loc_decl_section_paragraph__) :: r1109 in + let r1111 = [R 832] in + let r1112 = [R 389] in + let r1113 = S (N N_rl_loc_sentence__) :: r1112 in + let r1114 = S (T T_PERIOD) :: r1113 in + let r1115 = [R 2377] in + let r1116 = S (N N_rnel_use_after_exception_) :: r1115 in + let r1117 = S (T T_EC) :: r1116 in + let r1118 = S (T T_USE) :: r1117 in + let r1119 = [R 1303] in + let r1120 = Sub (r1118) :: r1119 in + let r1121 = S (T T_PERIOD) :: r1120 in + let r1122 = [R 993] in + let r1123 = Sub (r57) :: r1122 in + let r1124 = [R 2360] in + let r1125 = Sub (r1123) :: r1124 in + let r1126 = R 1236 :: r1125 in + let r1127 = R 1246 :: r1126 in + let r1128 = [R 2361] in + let r1129 = Sub (r1123) :: r1128 in + let r1130 = R 1236 :: r1129 in + let r1131 = [R 2368] in + let r1132 = Sub (r1123) :: r1131 in + let r1133 = R 1236 :: r1132 in + let r1134 = R 1246 :: r1133 in + let r1135 = [R 2369] in + let r1136 = Sub (r1123) :: r1135 in + let r1137 = R 1236 :: r1136 in + let r1138 = [R 2366] in + let r1139 = Sub (r1123) :: r1138 in + let r1140 = R 1236 :: r1139 in + let r1141 = [R 2367] in + let r1142 = Sub (r1123) :: r1141 in + let r1143 = R 1236 :: r1142 in + let r1144 = [R 2370] in + let r1145 = Sub (r1123) :: r1144 in + let r1146 = R 1236 :: r1145 in + let r1147 = R 1246 :: r1146 in + let r1148 = [R 2372] in + let r1149 = Sub (r1123) :: r1148 in + let r1150 = R 1236 :: r1149 in + let r1151 = R 1246 :: r1150 in + let r1152 = [R 2373] in + let r1153 = Sub (r1123) :: r1152 in + let r1154 = R 1236 :: r1153 in + let r1155 = [R 2371] in + let r1156 = Sub (r1123) :: r1155 in + let r1157 = R 1236 :: r1156 in + let r1158 = [R 2376] in + let r1159 = S (N N_rnel_use_after_exception_) :: r1158 in + let r1160 = [R 2380] in + let r1161 = [R 2357] in + let r1162 = [R 820] in + let r1163 = R 819 :: r1162 in + let r1164 = [R 2358] in + let r1165 = Sub (r1123) :: r1164 in + let r1166 = [R 2359] in + let r1167 = Sub (r1123) :: r1166 in + let r1168 = R 1236 :: r1167 in + let r1169 = [R 2381] in + let r1170 = [R 2379] in + let r1171 = S (N N_rnel_use_after_exception_) :: r1170 in + let r1172 = [R 2364] in + let r1173 = Sub (r1123) :: r1172 in + let r1174 = R 1236 :: r1173 in + let r1175 = R 1246 :: r1174 in + let r1176 = [R 2365] in + let r1177 = Sub (r1123) :: r1176 in + let r1178 = R 1236 :: r1177 in + let r1179 = [R 2378] in + let r1180 = S (N N_rnel_use_after_exception_) :: r1179 in + let r1181 = [R 2382] in + let r1182 = [R 2362] in + let r1183 = Sub (r1123) :: r1182 in + let r1184 = [R 2363] in + let r1185 = Sub (r1123) :: r1184 in + let r1186 = R 1236 :: r1185 in + let r1187 = [R 2383] in + let r1188 = [R 2375] in + let r1189 = S (N N_rnel_debug_target_) :: r1188 in + let r1190 = R 1236 :: r1189 in + let r1191 = [R 387] in + let r1192 = [R 149] in + let r1193 = [R 1597] in + let r1194 = S (N N_qualname) :: r1193 in + let r1195 = [R 386] in + let r1196 = S (T T_DIGITS) :: r1111 in + let r1197 = [R 1599] in + let r1198 = [R 2374] in + let r1199 = S (N N_ident) :: r1198 in + let r1200 = S (T T_REPORTING) :: r1199 in + let r1201 = [R 2442] in + let r1202 = S (N N_qualname) :: r1201 in + let r1203 = [R 2429] in + let r1204 = R 2413 :: r1203 in + let r1205 = S (N N_ro_retry_phrase_) :: r1204 in + let r1206 = S (N N_ro_advancing_phrase_) :: r1205 in + let r1207 = S (N N_ro_pf_FROM_ident_or_literal__) :: r1206 in + let r1208 = [R 2443] in + let r1209 = [R 1426] in + let r1210 = [R 42] in + let r1211 = [R 1755] in + let r1212 = [R 1754] in + let r1213 = S (T T_SECONDS) :: r1212 in + let r1214 = [R 1753] in + let r1215 = [R 2415] in + let r1216 = [R 2417] in + let r1217 = [R 2416] in + let r1218 = [R 2439] in + let r1219 = [R 2389] in + let r1220 = [R 2281] in + let r1221 = S (N N_rnel_unstring_target_) :: r1220 in + let r1222 = S (T T_INTO) :: r1221 in + let r1223 = S (N N_unstring_delimiters) :: r1222 in + let r1224 = [R 656] in + let r1225 = S (N N_ident) :: r1224 in + let r1226 = [R 2279] in + let r1227 = S (N N_l___anonymous_99_) :: r1226 in + let r1228 = Sub (r1225) :: r1227 in + let r1229 = R 114 :: r1228 in + let r1230 = [R 744] in + let r1231 = S (N N_l___anonymous_99_) :: r1230 in + let r1232 = Sub (r1225) :: r1231 in + let r1233 = [R 2312] in + let r1234 = S (N N_ro_pf___anonymous_101_ident__) :: r1233 in + let r1235 = [R 1454] in + let r1236 = S (N N_ident) :: r1235 in + let r1237 = [R 1456] in + let r1238 = S (N N_ident) :: r1237 in + let r1239 = [R 2289] in + let r1240 = S (N N_ident) :: r1239 in + let r1241 = [R 2293] in + let r1242 = [R 2277] in + let r1243 = R 181 :: r1242 in + let r1244 = [R 650] in + let r1245 = S (N N_ident) :: r1244 in + let r1246 = [R 648] in + let r1247 = S (N N_ident) :: r1246 in + let r1248 = [R 2221] in + let r1249 = Sub (r1247) :: r1248 in + let r1250 = S (T T_TO) :: r1249 in + let r1251 = Sub (r1245) :: r1250 in + let r1252 = S (T T_FROM) :: r1251 in + let r1253 = R 1190 :: r1252 in + let r1254 = [R 1119] in + let r1255 = Sub (r48) :: r1254 in + let r1256 = [R 2219] in + let r1257 = [R 2210] in + let r1258 = [R 2193] in + let r1259 = R 467 :: r1258 in + let r1260 = S (N N_rnel_rounded_ident_) :: r1259 in + let r1261 = S (T T_FROM) :: r1260 in + let r1262 = [R 1932] in + let r1263 = R 1935 :: r1262 in + let r1264 = S (N N_ident) :: r1263 in + let r1265 = [R 2201] in + let r1266 = R 467 :: r1265 in + let r1267 = Sub (r1264) :: r1266 in + let r1268 = S (T T_FROM) :: r1267 in + let r1269 = [R 2202] in + let r1270 = R 467 :: r1269 in + let r1271 = [R 2081] in + let r1272 = S (N N_ro_s_delimited_by_) :: r1271 in + let r1273 = Sub (r1245) :: r1272 in + let r1274 = [R 1109] in + let r1275 = Sub (r1273) :: r1274 in + let r1276 = [R 2167] in + let r1277 = S (N N_ident) :: r1276 in + let r1278 = S (T T_INTO) :: r1277 in + let r1279 = [R 2171] in + let r1280 = [R 2148] in + let r1281 = [R 2147] in + let r1282 = [R 2145] in + let r1283 = S (T T_ERROR) :: r1282 in + let r1284 = [R 2423] in + let r1285 = S (N N_ident_or_literal) :: r1284 in + let r1286 = R 1262 :: r1285 in + let r1287 = [R 2102] in + let r1288 = [R 2106] in + let r1289 = [R 2065] in + let r1290 = S (N N_ro_collating_sequence_phrase_) :: r1289 in + let r1291 = [R 2067] in + let r1292 = [R 713] in + let r1293 = [R 1572] in + let r1294 = S (N N_name) :: r1293 in + let r1295 = [R 712] in + let r1296 = S (N N_ro_pf_THROUGH_procedure_name__) :: r1295 in + let r1297 = Sub (r1294) :: r1296 in + let r1298 = R 1216 :: r1297 in + let r1299 = [R 1442] in + let r1300 = [R 1538] in + let r1301 = Sub (r57) :: r1300 in + let r1302 = S (T T_GIVING) :: r1301 in + let r1303 = [R 2069] in + let r1304 = [R 1537] in + let r1305 = S (N N_ro_pf_THROUGH_procedure_name__) :: r1304 in + let r1306 = Sub (r1294) :: r1305 in + let r1307 = R 1216 :: r1306 in + let r1308 = [R 2068] in + let r1309 = S (N N_ro_collating_sequence_phrase_) :: r1308 in + let r1310 = R 1238 :: r1309 in + let r1311 = R 1210 :: r1310 in + let r1312 = [R 2070] in + let r1313 = [R 257] in + let r1314 = Sub (r141) :: r1313 in + let r1315 = [R 2066] in + let r1316 = S (N N_ro_collating_sequence_phrase_) :: r1315 in + let r1317 = R 1238 :: r1316 in + let r1318 = R 1210 :: r1317 in + let r1319 = [R 1166] in + let r1320 = Sub (r706) :: r1319 in + let r1321 = R 1218 :: r1320 in + let r1322 = [R 1167] in + let r1323 = Sub (r706) :: r1322 in + let r1324 = [R 2041] in + let r1325 = [R 855] in + let r1326 = S (T T_USER_DEFAULT) :: r1325 in + let r1327 = [R 860] in + let r1328 = S (N N_ident) :: r1327 in + let r1329 = [R 2046] in + let r1330 = Sub (r1328) :: r1329 in + let r1331 = S (T T_TO) :: r1330 in + let r1332 = [R 2047] in + let r1333 = S (T T_OFF) :: r1332 in + let r1334 = S (T T_TO) :: r1333 in + let r1335 = [R 586] in + let r1336 = S (T T_FLOAT_INFINITY) :: r1335 in + let r1337 = [R 2048] in + let r1338 = S (N N_ro_sign_) :: r1337 in + let r1339 = Sub (r1336) :: r1338 in + let r1340 = S (T T_TO) :: r1339 in + let r1341 = S (N N_idents) :: r1340 in + let r1342 = [R 585] in + let r1343 = [R 584] in + let r1344 = [R 113] in + let r1345 = S (T T_FALSE) :: r1344 in + let r1346 = [R 1845] in + let r1347 = Sub (r1345) :: r1346 in + let r1348 = S (T T_TO) :: r1347 in + let r1349 = [R 1843] in + let r1350 = Sub (r1345) :: r1349 in + let r1351 = [R 1169] in + let r1352 = S (T T_OFF) :: r1351 in + let r1353 = [R 1841] in + let r1354 = Sub (r1352) :: r1353 in + let r1355 = S (T T_TO) :: r1354 in + let r1356 = [R 1839] in + let r1357 = Sub (r1352) :: r1356 in + let r1358 = [R 2037] in + let r1359 = S (N N_rnel_screen_attribute_on_off_) :: r1358 in + let r1360 = S (T T_ATTRIBUTE) :: r1359 in + let r1361 = [R 2045] in + let r1362 = [R 1964] in + let r1363 = [R 2314] in + let r1364 = S (T T_BY) :: r1363 in + let r1365 = S (T T_DOWN) :: r1364 in + let r1366 = [R 2040] in + let r1367 = S (N N_expression) :: r1366 in + let r1368 = [R 2313] in + let r1369 = [R 853] in + let r1370 = S (N N_expression) :: r1369 in + let r1371 = [R 2038] in + let r1372 = Sub (r1370) :: r1371 in + let r1373 = [R 751] in + let r1374 = S (T T_LC_ALL) :: r1373 in + let r1375 = [R 852] in + let r1376 = [R 2039] in + let r1377 = S (N N_expression) :: r1376 in + let r1378 = [R 2033] in + let r1379 = S (N N_ident) :: r1378 in + let r1380 = S (T T_FROM) :: r1379 in + let r1381 = [R 471] in + let r1382 = S (N N_ident) :: r1381 in + let r1383 = [R 2035] in + let r1384 = R 174 :: r1383 in + let r1385 = S (N N_ro_advancing_phrase_) :: r1384 in + let r1386 = [R 175] in + let r1387 = [R 40] in + let r1388 = S (T T_PAGE) :: r1387 in + let r1389 = [R 41] in + let r1390 = [R 2034] in + let r1391 = R 174 :: r1390 in + let r1392 = S (N N_ro_advancing_phrase_) :: r1391 in + let r1393 = [R 1992] in + let r1394 = S (N N_qualident) :: r1393 in + let r1395 = [R 1995] in + let r1396 = R 465 :: r1395 in + let r1397 = S (N N_imp_stmts) :: r1396 in + let r1398 = R 839 :: r1397 in + let r1399 = Sub (r1394) :: r1398 in + let r1400 = S (T T_WHEN) :: r1399 in + let r1401 = S (N N_qualname) :: r1400 in + let r1402 = [R 1765] in + let r1403 = R 2413 :: r1402 in + let r1404 = S (N N_ro_retry_phrase_) :: r1403 in + let r1405 = S (N N_ro_pf_FROM_ident_or_literal__) :: r1404 in + let r1406 = R 1250 :: r1405 in + let r1407 = [R 1769] in + let r1408 = [R 94] in + let r1409 = S (T T_AT_END) :: r1408 in + let r1410 = [R 1757] in + let r1411 = S (N N_imp_stmts) :: r1410 in + let r1412 = Sub (r1409) :: r1411 in + let r1413 = S (N N_ro_pf_INTO_loc_ident___) :: r1412 in + let r1414 = R 1250 :: r1413 in + let r1415 = [R 1434] in + let r1416 = [R 1751] in + let r1417 = S (T T_STATEMENT) :: r1416 in + let r1418 = S (T T_NEXT) :: r1417 in + let r1419 = [R 1652] in + let r1420 = S (N N_ro_pf_FROM_ident_or_literal__) :: r1419 in + let r1421 = [R 911] in + let r1422 = S (T T_MESSAGE) :: r1421 in + let r1423 = [R 1636] in + let r1424 = S (N N_ident) :: r1423 in + let r1425 = S (T T_INTO) :: r1424 in + let r1426 = Sub (r1422) :: r1425 in + let r1427 = [R 1640] in + let r1428 = [R 1622] in + let r1429 = S (N N_ro_pf___anonymous_86_qualname__) :: r1428 in + let r1430 = R 2413 :: r1429 in + let r1431 = S (N N_ro_lock_or_retry_) :: r1430 in + let r1432 = S (N N_ro_pf_INTO_ident__) :: r1431 in + let r1433 = R 1250 :: r1432 in + let r1434 = S (N N_ro_read_direction_) :: r1433 in + let r1435 = [R 1432] in + let r1436 = [R 867] in + let r1437 = [R 866] in + let r1438 = S (T T_LOCK) :: r1437 in + let r1439 = [R 1477] in + let r1440 = S (N N_qualname) :: r1439 in + let r1441 = [R 1632] in + let r1442 = [R 1611] in + let r1443 = [R 1610] in + let r1444 = [R 1590] in + let r1445 = [R 1556] in + let r1446 = S (N N_ro_pf_THROUGH_qualified_procedure_name__) :: r1445 in + let r1447 = [R 1554] in + let r1448 = Sub (r623) :: r1447 in + let r1449 = [R 652] in + let r1450 = S (N N_ident) :: r1449 in + let r1451 = [R 2403] in + let r1452 = Sub (r623) :: r1451 in + let r1453 = S (T T_UNTIL) :: r1452 in + let r1454 = S (N N_ro_pf_BY_ident_or_numeric__) :: r1453 in + let r1455 = Sub (r1450) :: r1454 in + let r1456 = S (T T_FROM) :: r1455 in + let r1457 = S (N N_ident) :: r1456 in + let r1458 = [R 1555] in + let r1459 = S (N N_l_pf_AFTER_loc_varying_phrase___) :: r1458 in + let r1460 = [R 748] in + let r1461 = S (N N_l_pf_AFTER_loc_varying_phrase___) :: r1460 in + let r1462 = [R 1422] in + let r1463 = [R 1558] in + let r1464 = S (T T_END_PERFORM) :: r1463 in + let r1465 = [R 1177] in + let r1466 = [R 1176] in + let r1467 = S (N N_rnel_file_with_opt_) :: r1466 in + let r1468 = S (N N_ro_retry_phrase_) :: r1467 in + let r1469 = [R 2053] in + let r1470 = Sub (r279) :: r1469 in + let r1471 = [R 570] in + let r1472 = [R 970] in + let r1473 = S (T T_REWIND) :: r1472 in + let r1474 = [R 969] in + let r1475 = [R 978] in + let r1476 = R 463 :: r1475 in + let r1477 = S (N N_rnel_rounded_ident_) :: r1476 in + let r1478 = S (T T_BY) :: r1477 in + let r1479 = [R 979] in + let r1480 = R 463 :: r1479 in + let r1481 = [R 975] in + let r1482 = S (N N_idents) :: r1481 in + let r1483 = S (T T_TO) :: r1482 in + let r1484 = [R 976] in + let r1485 = S (N N_idents) :: r1484 in + let r1486 = S (T T_TO) :: r1485 in + let r1487 = [R 910] in + let r1488 = Sub (r1302) :: r1487 in + let r1489 = Sub (r57) :: r1488 in + let r1490 = S (T T_USING) :: r1489 in + let r1491 = S (N N_ro_collating_sequence_phrase_) :: r1490 in + let r1492 = S (N N_rnel_on_key_) :: r1491 in + let r1493 = [R 654] in + let r1494 = S (N N_ident) :: r1493 in + let r1495 = [R 737] in + let r1496 = S (N N_ro_returning_) :: r1495 in + let r1497 = R 891 :: r1496 in + let r1498 = Sub (r1494) :: r1497 in + let r1499 = [R 892] in + let r1500 = [R 2385] in + let r1501 = [R 197] in + let r1502 = [R 716] in + let r1503 = S (N N_rnel_loc_replacing_phrase__) :: r1502 in + let r1504 = S (T T_REPLACING) :: r1503 in + let r1505 = [R 719] in + let r1506 = Sub (r1504) :: r1505 in + let r1507 = [R 715] in + let r1508 = [R 717] in + let r1509 = [R 1699] in + let r1510 = [R 637] in + let r1511 = S (N N_rl_inspect_where_) :: r1510 in + let r1512 = Sub (r1245) :: r1511 in + let r1513 = [R 721] in + let r1514 = Sub (r1245) :: r1513 in + let r1515 = [R 720] in + let r1516 = Sub (r1245) :: r1515 in + let r1517 = [R 768] in + let r1518 = [R 1700] in + let r1519 = [R 1697] in + let r1520 = S (N N_rl_inspect_where_) :: r1519 in + let r1521 = Sub (r1245) :: r1520 in + let r1522 = [R 1698] in + let r1523 = [R 2215] in + let r1524 = S (N N_rnel_loc_tallying_for__) :: r1523 in + let r1525 = [R 634] in + let r1526 = S (N N_rl_inspect_where_) :: r1525 in + let r1527 = Sub (r1245) :: r1526 in + let r1528 = [R 635] in + let r1529 = Sub (r1527) :: r1528 in + let r1530 = [R 2218] in + let r1531 = [R 2216] in + let r1532 = [R 2217] in + let r1533 = [R 718] in + let r1534 = S (N N_rl_inspect_where_) :: r1533 in + let r1535 = Sub (r1247) :: r1534 in + let r1536 = S (T T_TO) :: r1535 in + let r1537 = [R 710] in + let r1538 = [R 686] in + let r1539 = [R 702] in + let r1540 = [R 202] in + let r1541 = S (T T_VALUE) :: r1540 in + let r1542 = [R 705] in + let r1543 = S (T T_DEFAULT) :: r1542 in + let r1544 = [R 703] in + let r1545 = S (T T_DEFAULT) :: r1544 in + let r1546 = [R 2220] in + let r1547 = [R 1011] in + let r1548 = S (N N_ident_or_literal) :: r1547 in + let r1549 = S (T T_BY) :: r1548 in + let r1550 = [R 203] in + let r1551 = S (T T_VALUE) :: r1550 in + let r1552 = [R 709] in + let r1553 = S (T T_DEFAULT) :: r1552 in + let r1554 = [R 707] in + let r1555 = S (T T_DEFAULT) :: r1554 in + let r1556 = [R 697] in + let r1557 = S (T T_DEFAULT) :: r1556 in + let r1558 = [R 695] in + let r1559 = S (T T_DEFAULT) :: r1558 in + let r1560 = [R 701] in + let r1561 = S (T T_DEFAULT) :: r1560 in + let r1562 = [R 699] in + let r1563 = S (T T_DEFAULT) :: r1562 in + let r1564 = [R 689] in + let r1565 = S (T T_DEFAULT) :: r1564 in + let r1566 = [R 687] in + let r1567 = S (T T_DEFAULT) :: r1566 in + let r1568 = [R 693] in + let r1569 = S (T T_DEFAULT) :: r1568 in + let r1570 = [R 691] in + let r1571 = S (T T_DEFAULT) :: r1570 in + let r1572 = [R 660] in + let r1573 = S (N N_imp_stmts) :: r1572 in + let r1574 = [R 665] in + let r1575 = Sub (r1573) :: r1574 in + let r1576 = R 1274 :: r1575 in + let r1577 = [R 662] in + let r1578 = [R 444] in + let r1579 = [R 443] in + let r1580 = [R 622] in + let r1581 = [R 1612] in + let r1582 = [R 1613] in + let r1583 = [R 621] in + let r1584 = [R 620] in + let r1585 = S (N N_ident) :: r1584 in + let r1586 = R 1236 :: r1585 in + let r1587 = [R 616] in + let r1588 = [R 597] in + let r1589 = [R 493] in + let r1590 = [R 487] in + let r1591 = [R 490] in + let r1592 = [R 488] in + let r1593 = [R 489] in + let r1594 = [R 2030] in + let r1595 = S (T T_FALSE) :: r1594 in + let r1596 = [R 2031] in + let r1597 = Sub (r1595) :: r1596 in + let r1598 = [R 2408] in + let r1599 = S (N N_imp_stmts) :: r1598 in + let r1600 = S (N N_rnel_when_selection_objects_) :: r1599 in + let r1601 = [R 1111] in + let r1602 = Sub (r1600) :: r1601 in + let r1603 = [R 485] in + let r1604 = R 2406 :: r1603 in + let r1605 = Sub (r1602) :: r1604 in + let r1606 = [R 2025] in + let r1607 = S (T T_ANY) :: r1606 in + let r1608 = [R 2026] in + let r1609 = Sub (r1607) :: r1608 in + let r1610 = [R 2409] in + let r1611 = [R 1618] in + let r1612 = S (N N_ro_pf_IN_name__) :: r1611 in + let r1613 = S (N N_expression) :: r1612 in + let r1614 = S (T T_THROUGH) :: r1613 in + let r1615 = [R 1552] in + let r1616 = S (T T_OMITTED) :: r1615 in + let r1617 = [R 2027] in + let r1618 = [R 1546] in + let r1619 = [R 1617] in + let r1620 = S (N N_ro_pf_IN_name__) :: r1619 in + let r1621 = S (N N_expression) :: r1620 in + let r1622 = [R 1548] in + let r1623 = [R 475] in + let r1624 = S (T T_PERIOD) :: r1623 in + let r1625 = S (N N_ro_name_) :: r1624 in + let r1626 = [R 905] in + let r1627 = S (T T_OUTPUT) :: r1626 in + let r1628 = [R 901] in + let r1629 = S (N N_name) :: r1628 in + let r1630 = Sub (r1627) :: r1629 in + let r1631 = [R 445] in + let r1632 = [R 904] in + let r1633 = [R 903] in + let r1634 = [R 638] in + let r1635 = S (N N_ident) :: r1634 in + let r1636 = [R 2412] in + let r1637 = Sub (r1635) :: r1636 in + let r1638 = [R 421] in + let r1639 = R 461 :: r1638 in + let r1640 = S (N N_rnel_rounded_ident_) :: r1639 in + let r1641 = S (T T_INTO) :: r1640 in + let r1642 = [R 422] in + let r1643 = R 461 :: r1642 in + let r1644 = [R 408] in + let r1645 = R 459 :: r1644 in + let r1646 = [R 419] in + let r1647 = R 459 :: r1646 in + let r1648 = S (N N_imp_stmts) :: r1647 in + let r1649 = [R 407] in + let r1650 = [R 398] in + let r1651 = S (N N_ro_retry_phrase_) :: r1650 in + let r1652 = R 1250 :: r1651 in + let r1653 = [R 402] in + let r1654 = [R 303] in + let r1655 = S (N N_expression) :: r1654 in + let r1656 = S (T T_EQ) :: r1655 in + let r1657 = [R 305] in + let r1658 = [R 251] in + let r1659 = [R 1009] in + let r1660 = [R 248] in + let r1661 = [R 173] in + let r1662 = [R 247] in + let r1663 = [R 250] in + let r1664 = [R 249] in + let r1665 = [R 200] in + let r1666 = [R 186] in + let r1667 = S (T T_NESTED) :: r1666 in + let r1668 = [R 188] in + let r1669 = S (N N_ro_returning_) :: r1668 in + let r1670 = R 891 :: r1669 in + let r1671 = [R 646] in + let r1672 = S (N N_ident) :: r1671 in + let r1673 = [R 185] in + let r1674 = [R 194] in + let r1675 = [R 55] in + let r1676 = [R 746] in + let r1677 = S (N N_l_loc___anonymous_79__) :: r1676 in + let r1678 = Sub (r1194) :: r1677 in + let r1679 = R 1306 :: r1678 in + let r1680 = [R 1307] in + let r1681 = [R 49] in + let r1682 = S (N N_ro_returning_) :: r1681 in + let r1683 = R 122 :: r1682 in + let r1684 = S (T T_RETURNING) :: r1102 in + let r1685 = [R 48] in + let r1686 = Sub (r1684) :: r1685 in + let r1687 = R 122 :: r1686 in + let r1688 = [R 22] in + let r1689 = R 457 :: r1688 in + let r1690 = S (N N_rnel_rounded_ident_) :: r1689 in + let r1691 = S (T T_TO) :: r1690 in + let r1692 = [R 34] in + let r1693 = R 457 :: r1692 in + let r1694 = Sub (r1264) :: r1693 in + let r1695 = S (T T_TO) :: r1694 in + let r1696 = [R 35] in + let r1697 = R 457 :: r1696 in + let r1698 = [R 3] in + let r1699 = R 455 :: r1698 in + let r1700 = [R 6] in + let r1701 = R 455 :: r1700 in + let r1702 = S (T T_COUNT) :: r1701 in + let r1703 = [R 12] in + let r1704 = R 455 :: r1703 in + let r1705 = [R 964] in + let r1706 = [R 261] in + let r1707 = Sub (r1057) :: r1706 in + let r1708 = R 1232 :: r1707 in + let r1709 = S (T T_COL) :: r1708 in + let r1710 = [R 1564] in + let r1711 = Sub (r1709) :: r1710 in + let r1712 = [R 7] in + let r1713 = R 455 :: r1712 in + let r1714 = [R 759] in + let r1715 = Sub (r1057) :: r1714 in + let r1716 = [R 262] in + let r1717 = Sub (r1057) :: r1716 in + let r1718 = [R 9] in + let r1719 = R 455 :: r1718 in + let r1720 = [R 8] in + let r1721 = R 455 :: r1720 in + let r1722 = [R 963] in + let r1723 = [R 10] in + let r1724 = [R 11] in + let r1725 = R 455 :: r1724 in + let r1726 = [R 13] in + let r1727 = [R 4] in + let r1728 = R 455 :: r1727 in + let r1729 = [R 14] in + let r1730 = R 455 :: r1729 in + let r1731 = [R 16] in + let r1732 = R 455 :: r1731 in + let r1733 = [R 15] in + let r1734 = R 455 :: r1733 in + let r1735 = [R 17] in + let r1736 = [R 383] in + let r1737 = [R 382] in + let r1738 = [R 5] in + let r1739 = [R 957] in + let r1740 = [R 36] in + let r1741 = R 457 :: r1740 in + let r1742 = [R 958] in + let r1743 = [R 37] in + let r1744 = [R 23] in + let r1745 = R 457 :: r1744 in + let r1746 = [R 24] in + let r1747 = R 457 :: r1746 in + let r1748 = [R 25] in + let r1749 = [R 26] in + let r1750 = R 457 :: r1749 in + let r1751 = S (N N_rnel_rounded_ident_) :: r1750 in + let r1752 = [R 27] in + let r1753 = R 457 :: r1752 in + let r1754 = [R 28] in + let r1755 = R 457 :: r1754 in + let r1756 = [R 29] in + let r1757 = [R 30] in + let r1758 = R 457 :: r1757 in + let r1759 = [R 31] in + let r1760 = R 457 :: r1759 in + let r1761 = [R 32] in + let r1762 = R 457 :: r1761 in + let r1763 = [R 33] in + let r1764 = [R 190] in + let r1765 = [R 192] in + let r1766 = [R 307] in + let r1767 = [R 956] in + let r1768 = [R 400] in + let r1769 = [R 955] in + let r1770 = [R 414] in + let r1771 = R 459 :: r1770 in + let r1772 = [R 416] in + let r1773 = R 459 :: r1772 in + let r1774 = [R 415] in + let r1775 = R 459 :: r1774 in + let r1776 = [R 417] in + let r1777 = [R 418] in + let r1778 = R 459 :: r1777 in + let r1779 = [R 420] in + let r1780 = [R 2422] in + let r1781 = S (T T_ADVANCING) :: r1780 in + let r1782 = [R 2315] in + let r1783 = [R 2421] in + let r1784 = [R 413] in + let r1785 = [R 411] in + let r1786 = [R 412] in + let r1787 = [R 409] in + let r1788 = R 459 :: r1787 in + let r1789 = [R 410] in + let r1790 = [R 423] in + let r1791 = R 461 :: r1790 in + let r1792 = [R 424] in + let r1793 = [R 425] in + let r1794 = R 461 :: r1793 in + let r1795 = S (N N_ro_pf_REMAINDER_ident__) :: r1794 in + let r1796 = S (N N_rnel_rounded_ident_) :: r1795 in + let r1797 = [R 1440] in + let r1798 = [R 426] in + let r1799 = R 461 :: r1798 in + let r1800 = [R 427] in + let r1801 = R 461 :: r1800 in + let r1802 = [R 428] in + let r1803 = [R 429] in + let r1804 = R 461 :: r1803 in + let r1805 = S (N N_ro_pf_REMAINDER_ident__) :: r1804 in + let r1806 = S (N N_rnel_rounded_ident_) :: r1805 in + let r1807 = S (T T_GIVING) :: r1806 in + let r1808 = [R 430] in + let r1809 = R 461 :: r1808 in + let r1810 = [R 431] in + let r1811 = R 461 :: r1810 in + let r1812 = [R 432] in + let r1813 = [R 2407] in + let r1814 = S (N N_imp_stmts) :: r1813 in + let r1815 = [R 2032] in + let r1816 = [R 980] in + let r1817 = R 463 :: r1816 in + let r1818 = [R 981] in + let r1819 = [R 982] in + let r1820 = R 463 :: r1819 in + let r1821 = S (N N_rnel_rounded_ident_) :: r1820 in + let r1822 = [R 983] in + let r1823 = R 463 :: r1822 in + let r1824 = [R 984] in + let r1825 = R 463 :: r1824 in + let r1826 = [R 985] in + let r1827 = [R 1444] in + let r1828 = S (T T_AFTER) :: r1210 in + let r1829 = [R 2424] in + let r1830 = Sub (r1828) :: r1829 in + let r1831 = [R 1553] in + let r1832 = [R 1626] in + let r1833 = [R 960] in + let r1834 = [R 1630] in + let r1835 = [R 1624] in + let r1836 = [R 959] in + let r1837 = [R 1642] in + let r1838 = [R 1638] in + let r1839 = [R 1759] in + let r1840 = [R 1767] in + let r1841 = [R 1996] in + let r1842 = R 465 :: r1841 in + let r1843 = [R 57] in + let r1844 = [R 1990] in + let r1845 = S (N N_expression) :: r1844 in + let r1846 = R 1278 :: r1845 in + let r1847 = [R 1991] in + let r1848 = S (N N_expression) :: r1847 in + let r1849 = [R 1997] in + let r1850 = R 465 :: r1849 in + let r1851 = S (N N_imp_stmts) :: r1850 in + let r1852 = R 839 :: r1851 in + let r1853 = Sub (r1394) :: r1852 in + let r1854 = S (T T_WHEN) :: r1853 in + let r1855 = [R 1998] in + let r1856 = R 465 :: r1855 in + let r1857 = [R 2404] in + let r1858 = S (N N_imp_stmts) :: r1857 in + let r1859 = Sub (r623) :: r1858 in + let r1860 = S (T T_WHEN) :: r1859 in + let r1861 = [R 1103] in + let r1862 = Sub (r1860) :: r1861 in + let r1863 = [R 1993] in + let r1864 = R 465 :: r1863 in + let r1865 = Sub (r1862) :: r1864 in + let r1866 = [R 1452] in + let r1867 = [R 2405] in + let r1868 = [R 1994] in + let r1869 = R 465 :: r1868 in + let r1870 = Sub (r1862) :: r1869 in + let r1871 = [R 2122] in + let r1872 = [R 2120] in + let r1873 = [R 2126] in + let r1874 = S (N N_qualname) :: r1873 in + let r1875 = [R 2130] in + let r1876 = [R 2128] in + let r1877 = [R 2134] in + let r1878 = S (N N_expression) :: r1877 in + let r1879 = [R 2138] in + let r1880 = [R 2136] in + let r1881 = [R 2104] in + let r1882 = [R 2114] in + let r1883 = [R 2112] in + let r1884 = [R 966] in + let r1885 = [R 2175] in + let r1886 = S (N N_ident) :: r1885 in + let r1887 = [R 2179] in + let r1888 = [R 2177] in + let r1889 = [R 965] in + let r1890 = [R 2169] in + let r1891 = [R 1946] in + let r1892 = S (T T_SIZE) :: r1891 in + let r1893 = [R 2203] in + let r1894 = R 467 :: r1893 in + let r1895 = [R 2204] in + let r1896 = [R 2194] in + let r1897 = R 467 :: r1896 in + let r1898 = [R 2195] in + let r1899 = R 467 :: r1898 in + let r1900 = [R 2196] in + let r1901 = [R 2197] in + let r1902 = R 467 :: r1901 in + let r1903 = S (N N_rnel_rounded_ident_) :: r1902 in + let r1904 = [R 2198] in + let r1905 = R 467 :: r1904 in + let r1906 = [R 2199] in + let r1907 = R 467 :: r1906 in + let r1908 = [R 2200] in + let r1909 = [R 2291] in + let r1910 = [R 2285] in + let r1911 = [R 2297] in + let r1912 = S (N N_ident) :: r1911 in + let r1913 = [R 2305] in + let r1914 = S (N N_ident) :: r1913 in + let r1915 = [R 2309] in + let r1916 = [R 2307] in + let r1917 = [R 2301] in + let r1918 = [R 2299] in + let r1919 = [R 2283] in + let r1920 = [R 2433] in + let r1921 = [R 962] in + let r1922 = [R 2437] in + let r1923 = [R 2431] in + let r1924 = [R 961] in + let r1925 = [R 812] in + let r1926 = [R 2036] in + let r1927 = [R 816] in + let r1928 = [R 810] in + let r1929 = [R 1999] in + let r1930 = S (N N_rl_loc_sentence__) :: r1929 in + let r1931 = S (T T_PERIOD) :: r1930 in + let r1932 = [R 1305] in + let r1933 = [R 1571] in + let r1934 = S (N N_rl_loc_section_paragraph__) :: r1933 in + let r1935 = R 883 :: r1934 in + let r1936 = [R 1569] in + let r1937 = S (N N_rl_loc_section_paragraph__) :: r1936 in + let r1938 = R 883 :: r1937 in + let r1939 = [R 790] in + let r1940 = [R 242] in + let r1941 = S (T T_PERIOD) :: r1940 in + let r1942 = S (N N_name) :: r1941 in + let r1943 = S (T T_CLASS) :: r1942 in + let r1944 = S (T T_END) :: r1943 in + let r1945 = S (N N_ro_instance_definition_) :: r1944 in + let r1946 = S (N N_ro_loc_environment_division__) :: r1945 in + let r1947 = [R 547] in + let r1948 = R 875 :: r1947 in + let r1949 = S (T T_PERIOD) :: r1948 in + let r1950 = S (T T_FACTORY) :: r1949 in + let r1951 = [R 546] in + let r1952 = S (T T_PERIOD) :: r1951 in + let r1953 = S (T T_FACTORY) :: r1952 in + let r1954 = S (T T_END) :: r1953 in + let r1955 = S (N N_ro_object_procedure_division_) :: r1954 in + let r1956 = S (N N_ro_loc_data_division__) :: r1955 in + let r1957 = S (N N_ro_loc_environment_division__) :: r1956 in + let r1958 = S (N N_ro_options_paragraph_) :: r1957 in + let r1959 = [R 1147] in + let r1960 = R 877 :: r1959 in + let r1961 = S (T T_PERIOD) :: r1960 in + let r1962 = [R 878] in + let r1963 = S (T T_PERIOD) :: r1962 in + let r1964 = [R 876] in + let r1965 = S (T T_PERIOD) :: r1964 in + let r1966 = [R 722] in + let r1967 = S (T T_PERIOD) :: r1966 in + let r1968 = S (T T_OBJECT) :: r1967 in + let r1969 = S (T T_END) :: r1968 in + let r1970 = S (N N_ro_object_procedure_division_) :: r1969 in + let r1971 = S (N N_ro_loc_data_division__) :: r1970 in + let r1972 = S (N N_ro_loc_environment_division__) :: r1971 in + let r1973 = S (N N_ro_options_paragraph_) :: r1972 in + let r1974 = [R 243] in + let r1975 = S (T T_PERIOD) :: r1974 in + let r1976 = S (N N_name) :: r1975 in + let r1977 = S (T T_CLASS) :: r1976 in + let r1978 = S (T T_END) :: r1977 in + let r1979 = S (T T_OBJECT) :: r1961 in + let r1980 = [R 1577] in + let r1981 = S (T T_PERIOD) :: r1980 in + let r1982 = S (N N_name) :: r1981 in + let r1983 = S (T T_PROGRAM) :: r1982 in + let r1984 = S (T T_END) :: r1983 in + let r1985 = [R 796] in + let r1986 = [R 1579] in + let r1987 = S (T T_PERIOD) :: r1986 in + let r1988 = R 1284 :: r1987 in + let r1989 = Sub (r22) :: r1988 in + let r1990 = S (N N_name) :: r1989 in + let r1991 = S (T T_PERIOD) :: r1990 in + let r1992 = S (T T_PROGRAM_ID) :: r1991 in + let r1993 = [R 673] in + let r1994 = R 1369 :: r1993 in + let r1995 = R 1363 :: r1994 in + let r1996 = R 1365 :: r1995 in + let r1997 = R 1367 :: r1996 in + let r1998 = R 1361 :: r1997 in + let r1999 = [R 1578] in + let r2000 = S (N N_ro_loc_program_procedure_division__) :: r1999 in + let r2001 = S (N N_ro_loc_data_division__) :: r2000 in + let r2002 = S (N N_ro_loc_environment_division__) :: r2001 in + let r2003 = S (N N_ro_options_paragraph_) :: r2002 in + let r2004 = Sub (r1998) :: r2003 in + let r2005 = Sub (r1992) :: r2004 in + let r2006 = [R 1580] in + let r2007 = S (T T_COMMON) :: r2006 in + let r2008 = [R 1285] in + let r2009 = R 1248 :: r2008 in + let r2010 = Sub (r2007) :: r2009 in + let r2011 = [R 1583] in + let r2012 = R 2000 :: r2011 in + let r2013 = R 883 :: r2012 in + let r2014 = S (T T_PERIOD) :: r2013 in + let r2015 = S (N N_ro_returning_) :: r2014 in + let r2016 = [R 1585] in + let r2017 = R 2000 :: r2016 in + let r2018 = R 883 :: r2017 in + let r2019 = S (T T_PERIOD) :: r2018 in + let r2020 = S (N N_ro_returning_) :: r2019 in + let r2021 = [R 2002] in + let r2022 = [R 1586] in + let r2023 = R 2000 :: r2022 in + let r2024 = R 883 :: r2023 in + let r2025 = [R 1584] in + let r2026 = R 2000 :: r2025 in + let r2027 = R 883 :: r2026 in + let r2028 = [R 1588] in + let r2029 = [R 1587] in + let r2030 = S (T T_PERIOD) :: r2029 in + let r2031 = S (N N_name) :: r2030 in + let r2032 = S (T T_PROGRAM) :: r2031 in + let r2033 = S (T T_END) :: r2032 in + let r2034 = S (N N_ro_loc_procedure_division__) :: r2033 in + let r2035 = S (N N_ro_loc_data_division__) :: r2034 in + let r2036 = S (N N_ro_loc_environment_division__) :: r2035 in + let r2037 = [R 2100] in + function + | 0 | 3993 -> Nothing + | 3992 -> One ([R 0]) + | 3994 -> One ([R 1]) + | 560 -> One ([R 2]) + | 590 -> One ([R 19]) + | 589 -> One ([R 20]) + | 2352 -> One ([R 43]) + | 1474 -> One ([R 44]) + | 1958 -> One ([R 46]) + | 1956 -> One ([R 47]) + | 237 -> One ([R 52]) + | 234 -> One ([R 53]) + | 233 -> One ([R 54]) + | 658 -> One (R 59 :: r374) + | 661 -> One ([R 60]) + | 660 -> One ([R 61]) + | 659 -> One ([R 62]) + | 881 -> One ([R 63]) + | 874 -> One ([R 64]) + | 158 -> One ([R 67]) + | 157 -> One ([R 68]) + | 156 -> One ([R 69]) + | 939 -> One ([R 70]) + | 938 -> One ([R 71]) + | 941 -> One ([R 72]) + | 940 -> One ([R 73]) + | 936 -> One ([R 74]) + | 942 -> One ([R 75]) + | 937 -> One ([R 76]) + | 815 -> One ([R 77]) + | 866 -> One ([R 78]) + | 864 -> One ([R 79]) + | 880 -> One ([R 80]) + | 879 -> One ([R 81]) + | 840 -> One ([R 82]) + | 841 -> One ([R 83]) + | 835 -> One ([R 84]) + | 826 -> One ([R 85]) + | 827 -> One ([R 86]) + | 830 -> One ([R 87]) + | 833 -> One ([R 88]) + | 834 -> One ([R 89]) + | 2663 -> One ([R 93]) + | 3755 -> One ([R 95]) + | 3758 -> One ([R 96]) + | 3757 -> One ([R 97]) + | 944 -> One ([R 98]) + | 890 -> One ([R 100]) + | 1471 -> One ([R 102]) + | 2119 -> One ([R 103]) + | 2118 -> One ([R 104]) + | 1618 -> One ([R 107]) + | 1617 -> One ([R 108]) + | 1616 -> One ([R 110]) + | 1615 -> One ([R 111]) + | 2559 -> One ([R 112]) + | 2382 -> One (R 114 :: r1232) + | 2378 -> One ([R 115]) + | 2989 -> One (R 116 :: r1591) + | 2990 -> One ([R 117]) + | 2231 -> One ([R 119]) + | 1754 -> One ([R 121]) + | 1371 -> One ([R 123]) + | 2543 -> One (R 124 :: r1342) + | 2549 -> One (R 124 :: r1343) + | 2544 -> One ([R 125]) + | 549 -> One ([R 127]) + | 3009 -> One (R 128 :: r1616) + | 1203 | 1230 -> One ([R 129]) + | 1104 -> One ([R 131]) + | 484 -> One (R 132 :: r276) + | 485 -> One ([R 133]) + | 715 -> One ([R 135]) + | 318 -> One (R 136 :: r195) + | 319 -> One ([R 137]) + | 314 -> One ([R 139]) + | 1159 -> One (R 140 :: r604) + | 1413 -> One (R 140 :: r723) + | 1160 -> One ([R 141]) + | 3254 -> One (R 142 :: r1736) + | 3255 -> One ([R 143]) + | 3257 -> One (R 144 :: r1737) + | 3258 -> One ([R 145]) + | 184 -> One (R 152 :: r124) + | 1893 -> One (R 166 :: r979) + | 3083 -> One (R 172 :: r1660) + | 3087 -> One (R 172 :: r1662) + | 3898 | 3968 -> One ([R 177]) + | 2634 -> One (R 178 :: r1389) + | 2636 -> One ([R 179]) + | 2635 -> One ([R 180]) + | 2413 -> One ([R 182]) + | 2412 -> One ([R 183]) + | 3104 -> One ([R 184]) + | 3320 -> One ([R 187]) + | 3323 -> One ([R 189]) + | 3326 -> One ([R 191]) + | 3319 -> One ([R 193]) + | 3328 -> One ([R 195]) + | 3327 -> One ([R 196]) + | 2803 -> One ([R 198]) + | 2801 -> One ([R 199]) + | 263 -> One ([R 207]) + | 260 -> One ([R 208]) + | 265 -> One ([R 209]) + | 262 -> One ([R 210]) + | 376 -> One ([R 212]) + | 377 -> One ([R 213]) + | 375 -> One ([R 214]) + | 374 -> One ([R 215]) + | 373 -> One ([R 216]) + | 372 -> One ([R 217]) + | 370 -> One ([R 218]) + | 371 -> One ([R 219]) + | 1465 -> One ([R 221]) + | 1464 -> One ([R 222]) + | 1463 -> One ([R 223]) + | 1462 -> One ([R 224]) + | 1461 -> One ([R 225]) + | 1286 -> One ([R 228]) + | 1287 -> One ([R 229]) + | 1283 -> One ([R 230]) + | 1282 -> One ([R 231]) + | 1281 -> One ([R 232]) + | 1280 -> One ([R 233]) + | 1279 -> One ([R 234]) + | 1278 -> One ([R 235]) + | 1277 -> One ([R 236]) + | 1276 -> One ([R 237]) + | 1275 -> One ([R 238]) + | 1274 -> One ([R 239]) + | 1273 -> One ([R 240]) + | 1271 -> One ([R 241]) + | 616 -> One ([R 254]) + | 2031 -> One ([R 263]) + | 3893 -> One ([R 288]) + | 3964 -> One ([R 289]) + | 3969 -> One ([R 290]) + | 3971 -> One ([R 291]) + | 3967 -> One ([R 292]) + | 1194 -> One ([R 294]) + | 1336 -> One ([R 297]) + | 3334 -> One ([R 302]) + | 3330 -> One ([R 304]) + | 3333 -> One ([R 306]) + | 3336 -> One ([R 308]) + | 3335 -> One ([R 309]) + | 788 -> One ([R 314]) + | 1566 -> One ([R 315]) + | 1534 -> One ([R 316]) + | 2041 -> One ([R 320]) + | 2037 -> One ([R 321]) + | 2154 -> One ([R 322]) + | 2149 -> One ([R 323]) + | 1449 -> One ([R 328]) + | 1448 -> One ([R 329]) + | 3074 -> One ([R 330]) + | 811 -> One ([R 336]) + | 802 -> One ([R 337]) + | 808 -> One ([R 338]) + | 1487 -> One ([R 349]) + | 1480 -> One ([R 350]) + | 1522 -> One ([R 351]) + | 1521 -> One ([R 352]) + | 1520 -> One ([R 353]) + | 1519 -> One ([R 354]) + | 1517 -> One ([R 355]) + | 1508 -> One ([R 356]) + | 1507 -> One ([R 357]) + | 1506 -> One ([R 358]) + | 1505 -> One ([R 359]) + | 1503 -> One ([R 360]) + | 1513 -> One ([R 361]) + | 1490 -> One ([R 362]) + | 1488 -> One ([R 363]) + | 1484 -> One ([R 364]) + | 1483 -> One ([R 365]) + | 1482 -> One ([R 366]) + | 1481 -> One ([R 367]) + | 1512 -> One ([R 368]) + | 1478 -> One ([R 369]) + | 1476 -> One ([R 370]) + | 1511 -> One ([R 371]) + | 1498 -> One ([R 374]) + | 1500 -> One ([R 375]) + | 1499 -> One ([R 376]) + | 1059 -> One ([R 380]) + | 1055 -> One ([R 381]) + | 3253 -> One ([R 384]) + | 3241 -> One ([R 385]) + | 1441 -> One ([R 393]) + | 3346 -> One ([R 397]) + | 3345 -> One ([R 399]) + | 3340 -> One ([R 401]) + | 3348 -> One ([R 403]) + | 3347 -> One ([R 404]) + | 54 -> One ([R 435]) + | 52 -> One ([R 436]) + | 49 -> One ([R 437]) + | 53 -> One ([R 438]) + | 358 -> One ([R 442]) + | 136 -> One ([R 447]) + | 139 -> One ([R 448]) + | 137 -> One ([R 449]) + | 1116 -> One (R 450 :: r591) + | 1119 -> One (R 450 :: r592) + | 1118 -> One ([R 451]) + | 134 -> One ([R 453]) + | 3200 -> One ([R 454]) + | 3224 -> One (R 455 :: r1723) + | 3237 -> One (R 455 :: r1726) + | 3250 -> One (R 455 :: r1735) + | 3262 -> One (R 455 :: r1738) + | 3268 -> One ([R 456]) + | 3275 -> One (R 457 :: r1743) + | 3287 -> One (R 457 :: r1748) + | 3300 -> One (R 457 :: r1756) + | 3312 -> One (R 457 :: r1763) + | 3350 -> One ([R 458]) + | 3360 -> One (R 459 :: r1776) + | 3366 -> One (R 459 :: r1779) + | 3380 -> One (R 459 :: r1784) + | 3382 -> One (R 459 :: r1785) + | 3383 -> One (R 459 :: r1786) + | 3389 -> One (R 459 :: r1789) + | 3398 -> One ([R 460]) + | 3403 -> One (R 461 :: r1792) + | 3418 -> One (R 461 :: r1802) + | 3433 -> One (R 461 :: r1812) + | 3456 -> One ([R 462]) + | 3461 -> One (R 463 :: r1818) + | 3473 -> One (R 463 :: r1826) + | 3547 -> One ([R 464]) + | 3677 -> One ([R 466]) + | 3682 -> One (R 467 :: r1895) + | 3694 -> One (R 467 :: r1900) + | 3706 -> One (R 467 :: r1908) + | 132 -> One ([R 469]) + | 2620 -> One ([R 472]) + | 2621 -> One ([R 473]) + | 2622 -> One ([R 474]) + | 1769 -> One ([R 477]) + | 790 -> One ([R 478]) + | 2106 -> One ([R 481]) + | 3443 -> One ([R 484]) + | 2992 -> One ([R 491]) + | 2986 -> One ([R 492]) + | 977 -> One ([R 506]) + | 976 -> One ([R 524]) + | 1031 -> One ([R 531]) + | 903 -> One ([R 534]) + | 965 -> One ([R 537]) + | 1304 -> One ([R 538]) + | 1288 -> One ([R 539]) + | 1303 -> One ([R 540]) + | 1285 -> One ([R 541]) + | 796 -> One ([R 548]) + | 798 -> One ([R 549]) + | 800 -> One ([R 550]) + | 807 -> One ([R 551]) + | 814 -> One ([R 552]) + | 1652 -> One ([R 555]) + | 1648 -> One ([R 556]) + | 1649 -> One ([R 557]) + | 1655 -> One ([R 558]) + | 1624 -> One ([R 559]) + | 1647 -> One ([R 560]) + | 1619 -> One ([R 561]) + | 1653 -> One ([R 562]) + | 1646 -> One ([R 563]) + | 1654 -> One ([R 564]) + | 1623 -> One ([R 565]) + | 837 -> One ([R 571]) + | 1322 -> One ([R 575]) + | 1312 -> One ([R 576]) + | 1328 -> One ([R 577]) + | 1313 -> One ([R 578]) + | 2547 -> One ([R 587]) + | 2546 -> One ([R 588]) + | 836 -> One ([R 590]) + | 279 -> One ([R 593]) + | 822 -> One ([R 610]) + | 823 -> One ([R 611]) + | 773 -> One ([R 617]) + | 772 -> One ([R 618]) + | 2977 -> One ([R 619]) + | 1423 -> One ([R 625]) + | 858 -> One ([R 626]) + | 878 -> One ([R 627]) + | 865 -> One ([R 628]) + | 859 -> One ([R 629]) + | 860 -> One ([R 630]) + | 891 -> One ([R 631]) + | 886 -> One ([R 632]) + | 857 -> One ([R 633]) + | 2858 -> One ([R 636]) + | 3054 -> One ([R 639]) + | 3053 -> One ([R 640]) + | 2078 -> One ([R 642]) + | 2085 -> One ([R 643]) + | 1000 -> One ([R 644]) + | 998 -> One ([R 645]) + | 3106 -> One ([R 647]) + | 2425 -> One ([R 649]) + | 2419 -> One ([R 651]) + | 2723 -> One ([R 653]) + | 2793 -> One ([R 655]) + | 2380 -> One ([R 657]) + | 1080 -> One ([R 659]) + | 3452 -> One ([R 661]) + | 3450 -> One ([R 663]) + | 3454 -> One ([R 664]) + | 3175 -> One ([R 666]) + | 3165 -> One ([R 667]) + | 3143 -> One ([R 668]) + | 3174 -> One ([R 669]) + | 522 -> One ([R 670]) + | 521 -> One ([R 671]) + | 2893 -> One ([R 674]) + | 2892 -> One ([R 675]) + | 2891 -> One ([R 676]) + | 2890 -> One ([R 677]) + | 2889 -> One ([R 678]) + | 2888 -> One ([R 679]) + | 2887 -> One ([R 680]) + | 2886 -> One ([R 681]) + | 2885 -> One ([R 682]) + | 2884 -> One ([R 683]) + | 2883 -> One ([R 684]) + | 2882 -> One ([R 685]) + | 2938 -> One ([R 688]) + | 2945 -> One ([R 690]) + | 2946 -> One ([R 692]) + | 2922 -> One ([R 694]) + | 2923 -> One ([R 696]) + | 2930 -> One ([R 698]) + | 2931 -> One ([R 700]) + | 2897 -> One ([R 704]) + | 2914 -> One ([R 706]) + | 2915 -> One ([R 708]) + | 201 -> One ([R 723]) + | 199 -> One ([R 724]) + | 200 -> One ([R 725]) + | 821 -> One ([R 731]) + | 820 -> One ([R 732]) + | 819 -> One ([R 733]) + | 818 -> One ([R 734]) + | 817 -> One ([R 735]) + | 1501 -> One ([R 736]) + | 2602 -> One ([R 752]) + | 1588 -> One ([R 756]) + | 2017 -> One ([R 760]) + | 2020 -> One ([R 761]) + | 2834 -> One (R 767 :: r1517) + | 1393 -> One (R 769 :: r715) + | 1752 -> One (R 771 :: r900) + | 1775 -> One (R 773 :: r912) + | 1535 -> One (R 775 :: r769) + | 2039 -> One (R 777 :: r1041) + | 2152 -> One (R 779 :: r1081) + | 1514 -> One (R 781 :: r763) + | 1771 -> One (R 783 :: r911) + | 1650 -> One (R 785 :: r834) + | 1658 -> One (R 787 :: r835) + | 3827 -> One (R 789 :: r1939) + | 686 -> One (R 791 :: r382) + | 266 -> One (R 793 :: r165) + | 3895 -> One (R 795 :: r1984) + | 3896 -> One (R 795 :: r1985) + | 2042 -> One (R 797 :: r1042) + | 2050 -> One (R 799 :: r1043) + | 1982 -> One (R 801 :: r1020) + | 690 -> One (R 803 :: r383) + | 668 -> One (R 805 :: r375) + | 2131 -> One (R 807 :: r1080) + | 3788 -> One (R 809 :: r1928) + | 3774 -> One (R 811 :: r1925) + | 781 -> One (R 813 :: r454) + | 3779 -> One (R 815 :: r1927) + | 1761 -> One (R 817 :: r910) + | 627 -> One (R 821 :: r349) + | 853 -> One ([R 823]) + | 851 -> One ([R 824]) + | 848 -> One ([R 825]) + | 852 -> One ([R 826]) + | 907 -> One ([R 827]) + | 909 -> One ([R 828]) + | 908 -> One ([R 829]) + | 910 -> One ([R 830]) + | 2204 | 2712 -> One ([R 833]) + | 378 -> One ([R 834]) + | 384 -> One ([R 836]) + | 1557 -> One ([R 837]) + | 3561 -> One ([R 840]) + | 26 -> One (R 841 :: r18) + | 3970 -> One ([R 842]) + | 2527 -> One ([R 844]) + | 2526 -> One ([R 845]) + | 2525 -> One ([R 846]) + | 2524 -> One ([R 847]) + | 2523 -> One ([R 848]) + | 2522 -> One ([R 849]) + | 2521 -> One ([R 850]) + | 2534 -> One ([R 854]) + | 248 -> One ([R 857]) + | 247 -> One ([R 858]) + | 246 -> One ([R 859]) + | 2530 -> One ([R 861]) + | 2531 -> One ([R 862]) + | 543 -> One ([R 863]) + | 3514 -> One ([R 868]) + | 3798 -> One ([R 884]) + | 1391 -> One ([R 886]) + | 3050 -> One ([R 902]) + | 208 -> One ([R 907]) + | 209 -> One ([R 909]) + | 2677 -> One ([R 912]) + | 1805 -> One ([R 924]) + | 1492 -> One ([R 927]) + | 1857 -> One ([R 928]) + | 1858 -> One ([R 930]) + | 1861 -> One ([R 931]) + | 1862 -> One ([R 932]) + | 1863 -> One ([R 934]) + | 1866 -> One ([R 935]) + | 1871 -> One ([R 936]) + | 1872 -> One ([R 938]) + | 1870 -> One ([R 939]) + | 2080 -> One ([R 947]) + | 2079 -> One ([R 948]) + | 2081 -> One ([R 949]) + | 2082 -> One ([R 950]) + | 2099 -> One ([R 953]) + | 2104 -> One ([R 954]) + | 239 -> One ([R 967]) + | 236 -> One ([R 968]) + | 417 -> One ([R 973]) + | 415 -> One ([R 974]) + | 34 -> One ([R 986]) + | 572 -> One ([R 987]) + | 563 -> One ([R 988]) + | 562 -> One ([R 989]) + | 305 -> One ([R 991]) + | 2224 -> One ([R 994]) + | 362 -> One ([R 996]) + | 294 -> One ([R 998]) + | 682 -> One ([R 1000]) + | 1576 -> One ([R 1002]) + | 1038 -> One ([R 1004]) + | 1420 -> One ([R 1006]) + | 1052 -> One ([R 1008]) + | 3090 -> One ([R 1010]) + | 2908 -> One ([R 1012]) + | 904 -> One ([R 1013]) + | 905 -> One ([R 1014]) + | 2032 -> One ([R 1015]) + | 2033 -> One ([R 1016]) + | 2328 -> One ([R 1017]) + | 2329 -> One ([R 1018]) + | 2760 -> One ([R 1019]) + | 2761 -> One ([R 1020]) + | 1083 -> One ([R 1021]) + | 1084 -> One ([R 1022]) + | 2836 -> One ([R 1023]) + | 2837 -> One ([R 1024]) + | 3394 -> One ([R 1025]) + | 3395 -> One ([R 1026]) + | 3316 -> One ([R 1027]) + | 3317 -> One ([R 1028]) + | 3100 -> One ([R 1029]) + | 3101 -> One ([R 1030]) + | 295 -> One ([R 1031]) + | 296 -> One ([R 1032]) + | 2015 -> One ([R 1033]) + | 2016 -> One ([R 1034]) + | 1053 -> One ([R 1035]) + | 1054 -> One ([R 1036]) + | 388 -> One ([R 1037]) + | 389 -> One ([R 1038]) + | 1555 -> One ([R 1039]) + | 1556 -> One ([R 1040]) + | 2199 -> One ([R 1042]) + | 3785 -> One ([R 1043]) + | 3786 -> One ([R 1044]) + | 164 -> One ([R 1045]) + | 165 -> One ([R 1046]) + | 2847 -> One ([R 1047]) + | 2848 -> One ([R 1048]) + | 2134 -> One ([R 1049]) + | 2135 -> One ([R 1050]) + | 3937 -> One ([R 1051]) + | 3938 -> One ([R 1052]) + | 594 -> One ([R 1053]) + | 617 -> One ([R 1054]) + | 3934 -> One ([R 1055]) + | 3935 -> One ([R 1056]) + | 2126 -> One ([R 1057]) + | 2127 -> One ([R 1058]) + | 392 -> One ([R 1059]) + | 394 -> One ([R 1060]) + | 2863 -> One ([R 1061]) + | 2864 -> One ([R 1062]) + | 2796 -> One ([R 1063]) + | 2804 -> One ([R 1064]) + | 2175 -> One ([R 1065]) + | 2188 -> One ([R 1066]) + | 83 -> One ([R 1067]) + | 84 -> One ([R 1068]) + | 570 -> One ([R 1069]) + | 571 -> One ([R 1070]) + | 2515 -> One ([R 1071]) + | 2516 -> One ([R 1072]) + | 2741 -> One ([R 1073]) + | 2765 -> One ([R 1074]) + | 383 -> One ([R 1076]) + | 2978 -> One ([R 1077]) + | 2979 -> One ([R 1078]) + | 1378 -> One ([R 1079]) + | 1379 -> One ([R 1080]) + | 2770 -> One ([R 1081]) + | 2771 -> One ([R 1082]) + | 2585 -> One ([R 1083]) + | 2588 -> One ([R 1084]) + | 463 -> One ([R 1085]) + | 464 -> One ([R 1086]) + | 926 -> One ([R 1087]) + | 927 -> One ([R 1088]) + | 1970 -> One ([R 1089]) + | 1971 -> One ([R 1090]) + | 2390 -> One ([R 1091]) + | 2391 -> One ([R 1092]) + | 2271 -> One ([R 1093]) + | 2272 -> One ([R 1094]) + | 1074 -> One ([R 1095]) + | 1075 -> One ([R 1096]) + | 3033 -> One ([R 1097]) + | 3034 -> One ([R 1098]) + | 2185 -> One ([R 1101]) + | 3583 -> One ([R 1104]) + | 3197 -> One ([R 1105]) + | 3173 -> One ([R 1106]) + | 2179 -> One ([R 1108]) + | 3667 -> One ([R 1110]) + | 3441 -> One ([R 1112]) + | 2429 -> One ([R 1117]) + | 2428 -> One ([R 1118]) + | 58 -> One ([R 1120]) + | 46 | 845 -> One ([R 1121]) + | 47 | 846 -> One ([R 1122]) + | 48 | 847 -> One ([R 1123]) + | 50 | 849 -> One ([R 1124]) + | 1201 -> One ([R 1129]) + | 1341 -> One ([R 1130]) + | 1910 -> One ([R 1133]) + | 614 -> One ([R 1136]) + | 2724 -> One ([R 1137]) + | 2730 -> One ([R 1138]) + | 2729 -> One ([R 1139]) + | 2437 -> One ([R 1140]) + | 267 -> One ([R 1141]) + | 269 -> One ([R 1142]) + | 216 -> One ([R 1143]) + | 213 -> One ([R 1144]) + | 838 -> One ([R 1149]) + | 805 -> One ([R 1150]) + | 799 -> One ([R 1151]) + | 797 -> One ([R 1153]) + | 918 -> One ([R 1157]) + | 916 -> One ([R 1159]) + | 912 -> One ([R 1160]) + | 3199 -> One ([R 1164]) + | 3065 -> One ([R 1165]) + | 2570 -> One ([R 1168]) + | 2407 -> One ([R 1170]) + | 2408 -> One ([R 1171]) + | 2222 -> One ([R 1172]) + | 2220 -> One ([R 1173]) + | 2221 -> One ([R 1174]) + | 2223 -> One ([R 1175]) + | 2630 -> One (R 1178 :: r1388) + | 2631 -> One ([R 1179]) + | 774 -> One (R 1180 :: r451) + | 1041 -> One (R 1180 :: r558) + | 1539 -> One (R 1180 :: r781) + | 1579 -> One (R 1180 :: r800) + | 1592 -> One (R 1180 :: r812) + | 1784 -> One (R 1180 :: r929) + | 1830 -> One (R 1180 :: r949) + | 1847 -> One (R 1180 :: r959) + | 1911 -> One (R 1180 :: r987) + | 1945 -> One (R 1180 :: r1010) + | 775 -> One ([R 1181]) + | 663 -> One ([R 1183]) + | 1631 -> One (R 1184 :: r827) + | 1637 -> One (R 1184 :: r830) + | 2666 -> One (R 1184 :: r1418) + | 1632 -> One ([R 1185]) + | 1386 -> One (R 1186 :: r714) + | 1716 -> One (R 1186 :: r881) + | 2376 -> One (R 1186 :: r1229) + | 3669 -> One (R 1186 :: r1892) + | 1387 -> One ([R 1187]) + | 525 -> One (R 1188 :: r304) + | 1495 -> One (R 1188 :: r762) + | 212 -> One ([R 1189]) + | 274 -> One (R 1190 :: r171) + | 275 -> One ([R 1191]) + | 217 -> One (R 1192 :: r144) + | 218 -> One ([R 1193]) + | 742 -> One (R 1194 :: r431) + | 1610 -> One (R 1194 :: r820) + | 675 -> One ([R 1195]) + | 1601 -> One (R 1196 :: r816) + | 1604 -> One (R 1196 :: r817) + | 2904 -> One (R 1196 :: r1549) + | 1602 -> One ([R 1197]) + | 128 -> One (R 1198 :: r94) + | 141 -> One (R 1198 :: r99) + | 129 -> One ([R 1199]) + | 2101 -> One ([R 1201]) + | 638 -> One ([R 1203]) + | 554 -> One ([R 1205]) + | 277 -> One ([R 1207]) + | 77 -> One (R 1208 :: r59) + | 105 -> One (R 1208 :: r72) + | 78 -> One ([R 1209]) + | 1361 -> One (R 1210 :: r702) + | 2393 -> One (R 1210 :: r1236) + | 2397 -> One (R 1210 :: r1238) + | 2404 -> One (R 1210 :: r1240) + | 3724 -> One (R 1210 :: r1914) + | 745 -> One ([R 1211]) + | 1951 -> One (R 1212 :: r1012) + | 1952 -> One ([R 1213]) + | 2825 -> One (R 1214 :: r1514) + | 2829 -> One (R 1214 :: r1516) + | 2826 -> One ([R 1215]) + | 7 -> One (R 1216 :: r11) + | 15 -> One (R 1216 :: r15) + | 145 -> One (R 1216 :: r101) + | 154 -> One (R 1216 :: r109) + | 197 -> One (R 1216 :: r132) + | 322 -> One (R 1216 :: r197) + | 325 -> One (R 1216 :: r199) + | 509 -> One (R 1216 :: r296) + | 516 -> One (R 1216 :: r298) + | 532 -> One (R 1216 :: r308) + | 579 -> One (R 1216 :: r333) + | 778 -> One (R 1216 :: r453) + | 1057 -> One (R 1216 :: r564) + | 1061 -> One (R 1216 :: r573) + | 1085 -> One (R 1216 :: r579) + | 1168 -> One (R 1216 :: r607) + | 1345 -> One (R 1216 :: r685) + | 1421 -> One (R 1216 :: r728) + | 1431 -> One (R 1216 :: r734) + | 1436 -> One (R 1216 :: r736) + | 1439 -> One (R 1216 :: r738) + | 1459 -> One (R 1216 :: r753) + | 1573 -> One (R 1216 :: r798) + | 1582 -> One (R 1216 :: r802) + | 1585 -> One (R 1216 :: r806) + | 1697 -> One (R 1216 :: r867) + | 1711 -> One (R 1216 :: r875) + | 1720 -> One (R 1216 :: r883) + | 1729 -> One (R 1216 :: r888) + | 1732 -> One (R 1216 :: r890) + | 1735 -> One (R 1216 :: r892) + | 1738 -> One (R 1216 :: r894) + | 1741 -> One (R 1216 :: r896) + | 1786 -> One (R 1216 :: r930) + | 1790 -> One (R 1216 :: r932) + | 1806 -> One (R 1216 :: r943) + | 1811 -> One (R 1216 :: r945) + | 1835 -> One (R 1216 :: r952) + | 1840 -> One (R 1216 :: r955) + | 1849 -> One (R 1216 :: r960) + | 1851 -> One (R 1216 :: r962) + | 1855 -> One (R 1216 :: r964) + | 1913 -> One (R 1216 :: r988) + | 1947 -> One (R 1216 :: r1011) + | 1989 -> One (R 1216 :: r1023) + | 2059 -> One (R 1216 :: r1051) + | 2095 -> One (R 1216 :: r1066) + | 2121 -> One (R 1216 :: r1079) + | 2700 -> One (R 1216 :: r1440) + | 8 -> One ([R 1217]) + | 503 -> One (R 1218 :: r288) + | 508 -> One (R 1218 :: r292) + | 1373 -> One (R 1218 :: r709) + | 1381 -> One (R 1218 :: r712) + | 2509 -> One (R 1218 :: r1323) + | 504 -> One ([R 1219]) + | 1957 -> One ([R 1221]) + | 1427 -> One (R 1222 :: r732) + | 1428 -> One ([R 1223]) + | 535 -> One ([R 1225]) + | 1628 -> One ([R 1227]) + | 3137 -> One (R 1228 :: r1702) + | 3204 -> One ([R 1229]) + | 540 -> One (R 1230 :: r315) + | 586 -> One (R 1230 :: r339) + | 150 -> One ([R 1231]) + | 2074 -> One (R 1232 :: r1062) + | 2108 -> One (R 1232 :: r1074) + | 2112 -> One (R 1232 :: r1077) + | 3206 -> One (R 1232 :: r1715) + | 3209 -> One (R 1232 :: r1717) + | 2075 -> One ([R 1233]) + | 640 -> One (R 1234 :: r361) + | 643 -> One (R 1234 :: r363) + | 652 -> One (R 1234 :: r366) + | 1097 -> One (R 1234 :: r585) + | 1452 -> One (R 1234 :: r747) + | 1900 -> One (R 1234 :: r984) + | 2102 -> One (R 1234 :: r1071) + | 2194 -> One (R 1234 :: r1104) + | 2324 -> One (R 1234 :: r1192) + | 2539 -> One (R 1234 :: r1341) + | 641 -> One ([R 1235]) + | 1992 -> One (R 1236 :: r1026) + | 2281 -> One (R 1236 :: r1165) + | 2307 -> One (R 1236 :: r1183) + | 2695 -> One (R 1236 :: r1438) + | 760 -> One ([R 1237]) + | 2494 -> One ([R 1239]) + | 492 -> One (R 1240 :: r283) + | 493 -> One ([R 1241]) + | 182 -> One ([R 1243]) + | 2433 -> One (R 1244 :: r1257) + | 2434 -> One ([R 1245]) + | 2227 -> One (R 1246 :: r1130) + | 2237 -> One (R 1246 :: r1137) + | 2241 -> One (R 1246 :: r1140) + | 2245 -> One (R 1246 :: r1143) + | 2255 -> One (R 1246 :: r1154) + | 2263 -> One (R 1246 :: r1157) + | 2284 -> One (R 1246 :: r1168) + | 2298 -> One (R 1246 :: r1178) + | 2310 -> One (R 1246 :: r1186) + | 2217 -> One ([R 1247]) + | 203 -> One ([R 1249]) + | 2651 -> One ([R 1251]) + | 2322 -> One ([R 1253]) + | 1410 -> One (R 1254 :: r722) + | 1411 -> One ([R 1255]) + | 1547 -> One (R 1256 :: r787) + | 1548 -> One ([R 1257]) + | 328 -> One (R 1258 :: r203) + | 329 -> One ([R 1259]) + | 204 -> One (R 1260 :: r137) + | 205 -> One ([R 1261]) + | 396 -> One (R 1262 :: r237) + | 401 -> One (R 1262 :: r240) + | 405 -> One (R 1262 :: r243) + | 409 -> One (R 1262 :: r246) + | 397 -> One ([R 1263]) + | 310 -> One ([R 1265]) + | 673 -> One ([R 1269]) + | 3045 -> One (R 1270 :: r1633) + | 3046 -> One ([R 1271]) + | 1204 -> One (R 1272 :: r637) + | 1212 -> One (R 1272 :: r641) + | 1223 -> One (R 1272 :: r645) + | 1233 -> One (R 1272 :: r651) + | 1240 -> One (R 1272 :: r655) + | 1251 -> One (R 1272 :: r659) + | 1258 -> One (R 1272 :: r662) + | 1290 -> One (R 1272 :: r666) + | 1205 -> One ([R 1273]) + | 2881 -> One ([R 1275]) + | 1402 -> One ([R 1277]) + | 1110 -> One (R 1278 :: r590) + | 1162 -> One (R 1278 :: r606) + | 1218 -> One (R 1278 :: r644) + | 1246 -> One (R 1278 :: r658) + | 1264 -> One (R 1278 :: r665) + | 1296 -> One (R 1278 :: r669) + | 2894 -> One (R 1278 :: r1541) + | 2898 -> One (R 1278 :: r1543) + | 2901 -> One (R 1278 :: r1545) + | 2911 -> One (R 1278 :: r1551) + | 2916 -> One (R 1278 :: r1553) + | 2919 -> One (R 1278 :: r1555) + | 2924 -> One (R 1278 :: r1557) + | 2927 -> One (R 1278 :: r1559) + | 2932 -> One (R 1278 :: r1561) + | 2935 -> One (R 1278 :: r1563) + | 2939 -> One (R 1278 :: r1565) + | 2942 -> One (R 1278 :: r1567) + | 2947 -> One (R 1278 :: r1569) + | 2950 -> One (R 1278 :: r1571) + | 2971 -> One (R 1278 :: r1583) + | 3556 -> One (R 1278 :: r1848) + | 558 -> One ([R 1279]) + | 1064 -> One ([R 1281]) + | 488 -> One (R 1282 :: r281) + | 2743 -> One (R 1282 :: r1470) + | 185 -> One ([R 1283]) + | 1884 -> One (R 1294 :: r973) + | 1873 -> One (R 1298 :: r968) + | 1882 -> One ([R 1299]) + | 2210 -> One (R 1302 :: r1114) + | 3789 -> One (R 1304 :: r1931) + | 559 -> One (R 1308 :: r324) + | 573 -> One ([R 1309]) + | 2638 -> One ([R 1311]) + | 2805 -> One ([R 1313]) + | 1398 -> One ([R 1315]) + | 3096 -> One ([R 1317]) + | 2502 -> One ([R 1319]) + | 2161 -> One ([R 1321]) + | 704 -> One ([R 1323]) + | 3991 -> One ([R 1325]) + | 23 -> One ([R 1327]) + | 14 -> One (R 1328 :: r13) + | 20 -> One ([R 1329]) + | 25 -> One ([R 1331]) + | 765 -> One ([R 1333]) + | 1125 -> One ([R 1335]) + | 451 -> One ([R 1337]) + | 991 -> One ([R 1339]) + | 699 -> One ([R 1341]) + | 2168 -> One ([R 1343]) + | 3829 -> One ([R 1345]) + | 702 -> One ([R 1347]) + | 3885 -> One ([R 1349]) + | 2342 -> One ([R 1351]) + | 694 -> One ([R 1353]) + | 697 -> One ([R 1355]) + | 1783 -> One (R 1356 :: r928) + | 2163 -> One ([R 1360]) + | 3913 -> One ([R 1362]) + | 3919 -> One ([R 1364]) + | 3917 -> One ([R 1366]) + | 3915 -> One ([R 1368]) + | 3921 -> One ([R 1370]) + | 3820 -> One ([R 1372]) + | 1531 -> One ([R 1374]) + | 3822 -> One ([R 1376]) + | 3989 -> One ([R 1378]) + | 3894 -> One ([R 1380]) + | 3957 -> One ([R 1382]) + | 3387 -> One ([R 1384]) + | 2165 -> One ([R 1386]) + | 258 -> One ([R 1388]) + | 3516 -> One ([R 1390]) + | 21 -> One ([R 1392]) + | 232 -> One ([R 1394]) + | 476 -> One ([R 1396]) + | 3837 -> One ([R 1398]) + | 1101 -> One ([R 1400]) + | 3823 -> One ([R 1402]) + | 501 -> One ([R 1404]) + | 500 -> One ([R 1405]) + | 287 -> One (R 1406 :: r177) + | 2023 -> One (R 1406 :: r1038) + | 288 -> One ([R 1407]) + | 289 -> One ([R 1408]) + | 1825 -> One ([R 1410]) + | 1822 -> One ([R 1411]) + | 1961 -> One (R 1412 :: r1017) + | 1966 -> One (R 1412 :: r1019) + | 1963 -> One ([R 1413]) + | 1962 -> One ([R 1414]) + | 3491 -> One ([R 1416]) + | 1187 -> One ([R 1475]) + | 1348 -> One (R 1478 :: r689) + | 1357 -> One ([R 1483]) + | 3817 -> One ([R 1485]) + | 2969 -> One ([R 1487]) + | 3518 -> One ([R 1489]) + | 2158 -> One ([R 1491]) + | 472 -> One ([R 1493]) + | 2762 -> One ([R 1495]) + | 2810 -> One ([R 1497]) + | 3673 -> One ([R 1499]) + | 2155 -> One ([R 1501]) + | 2746 -> One ([R 1503]) + | 2552 -> One ([R 1505]) + | 1147 -> One ([R 1507]) + | 1146 -> One ([R 1508]) + | 191 -> One ([R 1510]) + | 432 -> One ([R 1512]) + | 1923 -> One ([R 1514]) + | 2457 -> One ([R 1516]) + | 2714 -> One ([R 1518]) + | 1665 -> One ([R 1520]) + | 170 -> One ([R 1524]) + | 161 -> One ([R 1525]) + | 169 -> One ([R 1526]) + | 168 -> One ([R 1527]) + | 167 -> One ([R 1528]) + | 166 -> One ([R 1529]) + | 534 -> One ([R 1533]) + | 601 -> One ([R 1535]) + | 1829 -> One ([R 1543]) + | 3013 -> One ([R 1547]) + | 3012 -> One ([R 1549]) + | 3031 -> One ([R 1550]) + | 3030 -> One ([R 1551]) + | 3483 -> One ([R 1557]) + | 2089 -> One ([R 1561]) + | 2088 -> One ([R 1562]) + | 3227 -> One ([R 1563]) + | 3228 -> One ([R 1565]) + | 3230 -> One ([R 1566]) + | 2478 -> One ([R 1573]) + | 2203 -> One ([R 1574]) + | 3783 -> One ([R 1575]) + | 3908 -> One ([R 1581]) + | 3907 -> One ([R 1582]) + | 1877 -> One ([R 1591]) + | 1878 -> One ([R 1592]) + | 854 -> One ([R 1593]) + | 992 -> One ([R 1594]) + | 2333 -> One ([R 1598]) + | 520 | 861 -> One ([R 1600]) + | 529 -> One ([R 1603]) + | 528 -> One ([R 1604]) + | 1589 -> One ([R 1605]) + | 1577 -> One ([R 1607]) + | 2964 -> One ([R 1614]) + | 2963 -> One ([R 1615]) + | 2687 -> One ([R 1619]) + | 2686 -> One ([R 1620]) + | 3503 -> One ([R 1621]) + | 3512 -> One ([R 1623]) + | 3497 -> One ([R 1625]) + | 3505 -> One ([R 1627]) + | 3504 -> One ([R 1628]) + | 3502 -> One ([R 1629]) + | 3494 -> One ([R 1631]) + | 3507 -> One ([R 1633]) + | 3506 -> One ([R 1634]) + | 3526 -> One ([R 1635]) + | 3529 -> One ([R 1637]) + | 3521 -> One ([R 1639]) + | 3525 -> One ([R 1641]) + | 1289 -> One ([R 1657]) + | 1222 -> One ([R 1665]) + | 1198 -> One ([R 1666]) + | 1250 -> One ([R 1667]) + | 1232 -> One ([R 1668]) + | 1298 -> One ([R 1673]) + | 1220 -> One ([R 1674]) + | 1266 -> One ([R 1675]) + | 1248 -> One ([R 1676]) + | 1221 -> One ([R 1677]) + | 1197 -> One ([R 1678]) + | 1249 -> One ([R 1679]) + | 1231 -> One ([R 1680]) + | 1295 -> One ([R 1685]) + | 1217 -> One ([R 1686]) + | 1263 -> One ([R 1687]) + | 1245 -> One ([R 1688]) + | 1228 -> One ([R 1693]) + | 1210 -> One ([R 1694]) + | 1256 -> One ([R 1695]) + | 1238 -> One ([R 1696]) + | 1875 -> One ([R 1705]) + | 2045 -> One ([R 1706]) + | 2047 -> One ([R 1707]) + | 2046 -> One ([R 1708]) + | 2043 -> One ([R 1709]) + | 1978 -> One ([R 1711]) + | 1986 -> One ([R 1712]) + | 1981 -> One ([R 1713]) + | 1985 -> One ([R 1714]) + | 1979 -> One ([R 1715]) + | 1974 -> One ([R 1716]) + | 2021 -> One ([R 1717]) + | 1983 -> One ([R 1718]) + | 2034 -> One ([R 1719]) + | 1973 -> One ([R 1720]) + | 1972 -> One ([R 1721]) + | 1977 -> One ([R 1722]) + | 1984 -> One ([R 1723]) + | 2022 -> One ([R 1724]) + | 1980 -> One ([R 1725]) + | 1969 -> One ([R 1726]) + | 1853 -> One ([R 1732]) + | 1899 -> One ([R 1735]) + | 1898 -> One ([R 1736]) + | 1897 -> One ([R 1737]) + | 1896 -> One ([R 1738]) + | 2670 -> One ([R 1752]) + | 3534 -> One ([R 1756]) + | 3533 -> One ([R 1758]) + | 2751 -> One (R 1761 :: r1471) + | 2755 -> One ([R 1762]) + | 2759 -> One ([R 1763]) + | 3541 -> One ([R 1764]) + | 3540 -> One ([R 1766]) + | 3537 -> One ([R 1768]) + | 3543 -> One ([R 1770]) + | 3542 -> One ([R 1771]) + | 2833 -> One ([R 1772]) + | 1392 -> One ([R 1773]) + | 1751 -> One ([R 1774]) + | 1774 -> One ([R 1775]) + | 1533 -> One ([R 1776]) + | 2038 -> One ([R 1777]) + | 2151 -> One ([R 1778]) + | 1502 -> One ([R 1779]) + | 1770 -> One ([R 1780]) + | 1625 -> One ([R 1781]) + | 1657 -> One ([R 1782]) + | 3830 -> One ([R 1783]) + | 688 -> One ([R 1784]) + | 270 -> One ([R 1785]) + | 2048 -> One ([R 1786]) + | 2052 -> One ([R 1787]) + | 2035 -> One ([R 1788]) + | 693 -> One ([R 1789]) + | 689 -> One ([R 1790]) + | 2148 -> One ([R 1791]) + | 3797 -> One ([R 1792]) + | 3782 -> One ([R 1793]) + | 1567 -> One ([R 1794]) + | 3777 -> One ([R 1795]) + | 1763 -> One ([R 1796]) + | 2278 -> One ([R 1797]) + | 630 -> One ([R 1798]) + | 877 -> One ([R 1799]) + | 2030 -> One ([R 1800]) + | 2327 -> One ([R 1801]) + | 2750 -> One ([R 1802]) + | 1081 | 2609 -> One ([R 1803]) + | 2821 -> One ([R 1804]) + | 3393 -> One ([R 1805]) + | 3315 -> One ([R 1806]) + | 3099 -> One ([R 1807]) + | 292 -> One ([R 1808]) + | 2014 -> One ([R 1809]) + | 1051 -> One ([R 1810]) + | 387 -> One ([R 1811]) + | 1554 -> One ([R 1812]) + | 3784 -> One ([R 1813]) + | 171 -> One ([R 1814]) + | 2849 -> One ([R 1815]) + | 3943 -> One ([R 1816]) + | 626 -> One ([R 1817]) + | 3942 -> One ([R 1818]) + | 431 -> One ([R 1819]) + | 2866 -> One ([R 1820]) + | 2807 -> One ([R 1821]) + | 3803 -> One ([R 1822]) + | 81 -> One ([R 1823]) + | 569 -> One ([R 1824]) + | 2517 -> One ([R 1825]) + | 2766 -> One ([R 1826]) + | 385 -> One ([R 1827]) + | 2980 -> One ([R 1828]) + | 1380 -> One ([R 1829]) + | 3290 -> One ([R 1830]) + | 2590 -> One ([R 1831]) + | 470 -> One ([R 1832]) + | 982 -> One ([R 1833]) + | 3750 -> One ([R 1834]) + | 2280 -> One ([R 1835]) + | 1077 -> One ([R 1836]) + | 3444 -> One ([R 1837]) + | 2605 -> One ([R 1838]) + | 2612 -> One ([R 1840]) + | 2608 -> One ([R 1842]) + | 2614 -> One ([R 1844]) + | 2816 -> One ([R 1846]) + | 2850 -> One ([R 1847]) + | 2629 -> One ([R 1848]) + | 1397 -> One ([R 1849]) + | 3091 -> One ([R 1850]) + | 2490 -> One ([R 1851]) + | 2160 -> One ([R 1852]) + | 703 -> One ([R 1853]) + | 764 -> One ([R 1854]) + | 1123 -> One ([R 1855]) + | 450 -> One ([R 1856]) + | 990 -> One ([R 1857]) + | 698 -> One ([R 1858]) + | 2167 -> One ([R 1859]) + | 3826 -> One ([R 1860]) + | 701 -> One ([R 1861]) + | 3884 -> One ([R 1862]) + | 2341 -> One ([R 1863]) + | 696 -> One ([R 1864]) + | 2162 -> One ([R 1865]) + | 3819 -> One ([R 1866]) + | 1523 -> One ([R 1867]) + | 3821 -> One ([R 1868]) + | 3990 -> One ([R 1869]) + | 3958 -> One ([R 1870]) + | 3392 -> One ([R 1871]) + | 2164 -> One ([R 1872]) + | 257 -> One ([R 1873]) + | 3515 -> One ([R 1874]) + | 231 -> One ([R 1875]) + | 475 -> One ([R 1876]) + | 3836 -> One ([R 1877]) + | 1100 -> One ([R 1878]) + | 3824 -> One ([R 1879]) + | 3492 -> One ([R 1880]) + | 75 -> One ([R 1881]) + | 1039 -> One ([R 1882]) + | 2734 -> One ([R 1883]) + | 1040 -> One ([R 1884]) + | 2674 -> One ([R 1885]) + | 1396 -> One ([R 1886]) + | 286 -> One ([R 1887]) + | 3517 -> One ([R 1888]) + | 3535 -> One ([R 1889]) + | 656 -> One ([R 1890]) + | 683 -> One ([R 1891]) + | 3421 -> One ([R 1892]) + | 2480 -> One ([R 1893]) + | 3490 -> One ([R 1894]) + | 363 -> One ([R 1895]) + | 1395 -> One ([R 1896]) + | 568 -> One ([R 1897]) + | 3589 -> One ([R 1898]) + | 2402 -> One ([R 1899]) + | 2401 -> One ([R 1900]) + | 334 -> One ([R 1901]) + | 1641 -> One ([R 1902]) + | 1630 -> One ([R 1903]) + | 1820 -> One ([R 1904]) + | 1819 -> One ([R 1905]) + | 1816 -> One ([R 1906]) + | 1815 -> One ([R 1907]) + | 1435 -> One ([R 1908]) + | 1184 -> One ([R 1909]) + | 3513 -> One ([R 1910]) + | 1089 -> One ([R 1911]) + | 1358 -> One ([R 1912]) + | 3818 -> One ([R 1913]) + | 2970 -> One ([R 1914]) + | 3519 -> One ([R 1915]) + | 2159 -> One ([R 1916]) + | 473 -> One ([R 1917]) + | 2763 -> One ([R 1918]) + | 2811 -> One ([R 1919]) + | 3675 -> One ([R 1920]) + | 2157 -> One ([R 1921]) + | 2764 -> One ([R 1922]) + | 2554 -> One ([R 1923]) + | 1150 -> One ([R 1924]) + | 477 -> One ([R 1925]) + | 474 -> One ([R 1926]) + | 1925 -> One ([R 1927]) + | 2459 -> One ([R 1928]) + | 3484 -> One ([R 1929]) + | 2166 -> One ([R 1930]) + | 1988 -> One ([R 1933]) + | 1987 -> One (R 1935 :: r1021) + | 1996 -> One ([R 1936]) + | 125 -> One ([R 1938]) + | 124 -> One ([R 1939]) + | 123 -> One ([R 1940]) + | 122 -> One ([R 1941]) + | 121 -> One ([R 1942]) + | 120 -> One ([R 1943]) + | 119 -> One ([R 1944]) + | 3672 -> One ([R 1945]) + | 2120 -> One ([R 1949]) + | 2116 -> One ([R 1950]) + | 2091 -> One ([R 1951]) + | 2073 -> One ([R 1952]) + | 2068 -> One ([R 1953]) + | 2064 -> One ([R 1954]) + | 2139 -> One ([R 1957]) + | 2584 -> One ([R 1958]) + | 2583 -> One ([R 1959]) + | 2582 -> One ([R 1960]) + | 2581 -> One ([R 1961]) + | 2580 -> One ([R 1962]) + | 2579 -> One ([R 1963]) + | 2142 -> One ([R 1967]) + | 2130 -> One ([R 1968]) + | 2132 -> One ([R 1969]) + | 2145 -> One ([R 1970]) + | 2143 -> One ([R 1971]) + | 2133 -> One ([R 1972]) + | 2137 -> One ([R 1973]) + | 2125 -> One ([R 1974]) + | 2144 -> One ([R 1975]) + | 2141 -> One ([R 1976]) + | 2128 -> One ([R 1977]) + | 2092 -> One ([R 1978]) + | 2124 -> One ([R 1979]) + | 2067 -> One ([R 1980]) + | 2069 -> One ([R 1981]) + | 2129 -> One ([R 1982]) + | 2136 -> One ([R 1983]) + | 3941 -> One ([R 2001]) + | 621 -> One ([R 2005]) + | 623 -> One ([R 2006]) + | 622 -> One ([R 2007]) + | 620 -> One ([R 2008]) + | 619 -> One ([R 2009]) + | 618 -> One ([R 2010]) + | 600 -> One ([R 2011]) + | 599 -> One ([R 2012]) + | 598 -> One ([R 2013]) + | 597 -> One ([R 2014]) + | 596 -> One ([R 2015]) + | 595 -> One ([R 2016]) + | 593 -> One ([R 2017]) + | 1172 -> One ([R 2019]) + | 3028 -> One ([R 2020]) + | 3022 -> One ([R 2021]) + | 3023 -> One ([R 2022]) + | 3003 -> One ([R 2023]) + | 3014 -> One ([R 2024]) + | 3448 -> One ([R 2028]) + | 2999 -> One ([R 2029]) + | 2566 -> One ([R 2042]) + | 2562 -> One ([R 2043]) + | 2555 -> One ([R 2044]) + | 929 -> One ([R 2054]) + | 1284 -> One ([R 2057]) + | 1268 -> One ([R 2058]) + | 1269 -> One ([R 2059]) + | 1272 -> One ([R 2060]) + | 782 -> One ([R 2062]) + | 785 -> One ([R 2063]) + | 784 -> One ([R 2064]) + | 2138 -> One ([R 2078]) + | 2003 -> One ([R 2080]) + | 427 -> One ([R 2082]) + | 426 -> One ([R 2083]) + | 425 -> One ([R 2084]) + | 424 -> One ([R 2085]) + | 423 -> One ([R 2086]) + | 422 -> One ([R 2087]) + | 421 -> One ([R 2088]) + | 420 -> One ([R 2089]) + | 419 -> One ([R 2090]) + | 391 -> One ([R 2091]) + | 393 -> One ([R 2092]) + | 467 -> One ([R 2095]) + | 465 -> One ([R 2096]) + | 466 -> One ([R 2097]) + | 3640 -> One ([R 2101]) + | 3629 -> One ([R 2103]) + | 3591 -> One ([R 2105]) + | 3642 -> One ([R 2107]) + | 3641 -> One ([R 2108]) + | 3637 -> One ([R 2109]) + | 3630 -> One ([R 2110]) + | 3636 -> One ([R 2111]) + | 3633 -> One ([R 2113]) + | 3639 -> One ([R 2115]) + | 3638 -> One ([R 2116]) + | 3599 -> One ([R 2117]) + | 3592 -> One ([R 2118]) + | 3598 -> One ([R 2119]) + | 3595 -> One ([R 2121]) + | 3601 -> One ([R 2123]) + | 3600 -> One ([R 2124]) + | 3612 -> One ([R 2125]) + | 3611 -> One ([R 2127]) + | 3608 -> One ([R 2129]) + | 3626 -> One ([R 2131]) + | 3625 -> One ([R 2132]) + | 3622 -> One ([R 2133]) + | 3621 -> One ([R 2135]) + | 3618 -> One ([R 2137]) + | 3624 -> One ([R 2139]) + | 3623 -> One ([R 2140]) + | 416 -> One ([R 2143]) + | 2452 -> One ([R 2146]) + | 44 -> One ([R 2149]) + | 43 -> One ([R 2150]) + | 40 -> One ([R 2151]) + | 67 | 350 -> One ([R 2155]) + | 64 | 349 -> One ([R 2156]) + | 37 | 61 -> One ([R 2157]) + | 38 | 62 -> One ([R 2158]) + | 39 | 63 -> One ([R 2159]) + | 41 | 65 -> One ([R 2160]) + | 42 | 66 -> One ([R 2161]) + | 360 -> One ([R 2163]) + | 3647 -> One ([R 2166]) + | 3664 -> One ([R 2168]) + | 3644 -> One ([R 2170]) + | 3666 -> One ([R 2172]) + | 3665 -> One ([R 2173]) + | 3654 -> One ([R 2174]) + | 3659 -> One ([R 2176]) + | 3653 -> One ([R 2178]) + | 3661 -> One ([R 2180]) + | 3660 -> One ([R 2181]) + | 315 -> One ([R 2183]) + | 922 -> One ([R 2185]) + | 1046 -> One ([R 2186]) + | 925 -> One ([R 2188]) + | 933 -> One ([R 2189]) + | 1906 -> One ([R 2208]) + | 1167 -> One ([R 2212]) + | 1166 -> One ([R 2213]) + | 1165 -> One ([R 2214]) + | 3139 -> One ([R 2224]) + | 3140 -> One ([R 2225]) + | 3141 -> One ([R 2226]) + | 3142 -> One ([R 2227]) + | 3144 -> One ([R 2228]) + | 3145 -> One ([R 2229]) + | 3146 -> One ([R 2230]) + | 3147 -> One ([R 2231]) + | 3148 -> One ([R 2232]) + | 3149 -> One ([R 2233]) + | 3150 -> One ([R 2234]) + | 3151 -> One ([R 2235]) + | 3152 -> One ([R 2236]) + | 3153 -> One ([R 2237]) + | 3154 -> One ([R 2238]) + | 3155 -> One ([R 2239]) + | 3156 -> One ([R 2240]) + | 3157 -> One ([R 2241]) + | 3158 -> One ([R 2242]) + | 3159 -> One ([R 2243]) + | 3160 -> One ([R 2244]) + | 3161 -> One ([R 2245]) + | 3162 -> One ([R 2246]) + | 3163 -> One ([R 2247]) + | 3164 -> One ([R 2248]) + | 3166 -> One ([R 2249]) + | 3167 -> One ([R 2250]) + | 3168 -> One ([R 2251]) + | 3169 -> One ([R 2252]) + | 3170 -> One ([R 2253]) + | 3171 -> One ([R 2254]) + | 3172 -> One ([R 2255]) + | 3176 -> One ([R 2256]) + | 3177 -> One ([R 2257]) + | 3178 -> One ([R 2258]) + | 3179 -> One ([R 2259]) + | 3180 -> One ([R 2260]) + | 3181 -> One ([R 2261]) + | 3182 -> One ([R 2262]) + | 3183 -> One ([R 2263]) + | 3184 -> One ([R 2264]) + | 3185 -> One ([R 2265]) + | 3186 -> One ([R 2266]) + | 3187 -> One ([R 2267]) + | 3188 -> One ([R 2268]) + | 3189 -> One ([R 2269]) + | 3190 -> One ([R 2270]) + | 3191 -> One ([R 2271]) + | 3192 -> One ([R 2272]) + | 3193 -> One ([R 2273]) + | 3194 -> One ([R 2274]) + | 3195 -> One ([R 2275]) + | 3196 -> One ([R 2276]) + | 3720 -> One ([R 2280]) + | 3747 -> One ([R 2282]) + | 3719 -> One ([R 2284]) + | 3749 -> One ([R 2286]) + | 3748 -> One ([R 2287]) + | 3711 -> One ([R 2288]) + | 3714 -> One ([R 2290]) + | 3710 -> One ([R 2292]) + | 3716 -> One ([R 2294]) + | 3715 -> One ([R 2295]) + | 3739 -> One ([R 2296]) + | 3742 -> One ([R 2298]) + | 3738 -> One ([R 2300]) + | 3744 -> One ([R 2302]) + | 3743 -> One ([R 2303]) + | 3730 -> One ([R 2304]) + | 3733 -> One ([R 2306]) + | 3729 -> One ([R 2308]) + | 3735 -> One ([R 2310]) + | 3734 -> One ([R 2311]) + | 3374 -> One ([R 2316]) + | 3373 -> One ([R 2317]) + | 3376 -> One ([R 2318]) + | 3375 -> One ([R 2319]) + | 1130 -> One ([R 2321]) + | 1109 -> One ([R 2322]) + | 1094 -> One ([R 2323]) + | 1144 -> One ([R 2324]) + | 1115 -> One ([R 2329]) + | 1114 -> One ([R 2330]) + | 1113 -> One ([R 2331]) + | 1108 -> One ([R 2337]) + | 1143 -> One ([R 2342]) + | 1142 -> One ([R 2343]) + | 1141 -> One ([R 2344]) + | 1138 -> One ([R 2345]) + | 1137 -> One ([R 2346]) + | 1136 -> One ([R 2347]) + | 1135 -> One ([R 2348]) + | 1134 -> One ([R 2349]) + | 1131 -> One ([R 2350]) + | 1132 -> One ([R 2351]) + | 1133 -> One ([R 2352]) + | 1140 -> One ([R 2353]) + | 1139 -> One ([R 2354]) + | 1479 -> One ([R 2356]) + | 2799 -> One ([R 2384]) + | 2187 -> One ([R 2386]) + | 1518 -> One ([R 2391]) + | 1510 -> One ([R 2392]) + | 1509 -> One ([R 2393]) + | 1504 -> One ([R 2394]) + | 1489 -> One ([R 2395]) + | 1475 -> One ([R 2396]) + | 1477 -> One ([R 2397]) + | 1072 -> One ([R 2398]) + | 1073 -> One ([R 2399]) + | 1071 -> One ([R 2400]) + | 3522 -> One ([R 2410]) + | 2682 -> One ([R 2411]) + | 2369 -> One ([R 2414]) + | 551 -> One ([R 2420]) + | 10 -> One ([R 2425]) + | 3764 -> One ([R 2428]) + | 3773 -> One ([R 2430]) + | 3756 -> One ([R 2432]) + | 3766 -> One ([R 2434]) + | 3765 -> One ([R 2435]) + | 3763 -> One ([R 2436]) + | 3752 -> One ([R 2438]) + | 3768 -> One ([R 2440]) + | 3767 -> One ([R 2441]) + | 1170 -> One (S (T T_WHEN) :: r609) + | 1189 -> One (S (T T_WHEN) :: r625) + | 1417 -> One (S (T T_WHEN) :: r726) + | 743 -> One (S (T T_VARYING) :: r438) + | 555 -> One (S (T T_USING) :: r321) + | 2715 -> One (S (T T_UNTIL) :: r1448) + | 2563 -> One (S (T T_TO) :: r1350) + | 2574 -> One (S (T T_TO) :: r1357) + | 2599 -> One (S (T T_TO) :: r1372) + | 2610 -> One (S (T T_TO) :: r1377) + | 3114 -> One (S (T T_TO) :: r1679) + | 3116 -> One (S (T T_TO) :: r1680) + | 2360 -> One (S (T T_TIMES) :: r1214) + | 3488 -> One (S (T T_TIMES) :: r1831) + | 3024 -> One (S (T T_THROUGH) :: r1621) + | 3485 -> One (S (T T_TEST) :: r1830) + | 3043 -> One (S (T T_TERMINAL) :: r1632) + | 297 -> One (S (T T_TABLE) :: r181) + | 341 -> One (S (T T_STATUS) :: r211) + | 602 -> One (S (T T_STATUS) :: r342) + | 538 -> One (S (T T_SEQUENTIAL) :: r309) + | 606 -> One (S (T T_SEQUENCE) :: r345) + | 2499 -> One (S (T T_SEQUENCE) :: r1314) + | 2956 -> One (S (T T_SENTENCE) :: r1577) + | 2959 -> One (S (T T_SENTENCE) :: r1579) + | 3545 -> One (S (T T_SENTENCE) :: r1842) + | 3567 -> One (S (T T_SENTENCE) :: r1856) + | 3578 -> One (S (T T_SENTENCE) :: r1867) + | 4 -> One (S (T T_SECTION) :: r7) + | 177 -> One (S (T T_SECTION) :: r120) + | 479 -> One (S (T T_SECTION) :: r270) + | 737 -> One (S (T T_SECTION) :: r424) + | 1661 -> One (S (T T_SECTION) :: r838) + | 1667 -> One (S (T T_SECTION) :: r841) + | 1672 -> One (S (T T_SECTION) :: r844) + | 1677 -> One (S (T T_SECTION) :: r847) + | 1778 -> One (S (T T_SECTION) :: r915) + | 2054 -> One (S (T T_SECTION) :: r1046) + | 825 -> One (S (T T_RPAR) :: r470) + | 872 -> One (S (T T_RPAR) :: r490) + | 875 -> One (S (T T_RPAR) :: r491) + | 980 -> One (S (T T_RPAR) :: r534) + | 1014 -> One (S (T T_RPAR) :: r546) + | 116 -> One (S (T T_ROUNDING) :: r87) + | 148 -> One (S (T T_ROUNDED) :: r105) + | 2756 -> One (S (T T_REWIND) :: r1474) + | 3093 -> One (S (T T_REWIND) :: r1664) + | 1938 -> One (S (T T_RESET) :: r1005) + | 1524 -> One (S (T T_RENAMES) :: r767) + | 3084 -> One (S (T T_REMOVAL) :: r1661) + | 1095 -> One (S (T T_REFERENCE) :: r584) + | 2176 -> One (S (T T_REFERENCE) :: r1096) + | 2800 -> One (S (T T_REFERENCE) :: r1501) + | 574 -> One (S (T T_RECORD) :: r331) + | 1443 | 1515 -> One (S (T T_RECORD) :: r739) + | 1728 -> One (S (T T_QUEUE) :: r886) + | 95 -> One (S (T T_PROTOTYPE) :: r62) + | 712 -> One (S (T T_PROPERTY) :: r406) + | 720 -> One (S (T T_PROPERTY) :: r411) + | 2321 -> One (S (T T_PROCEDURES) :: r1191) + | 2471 -> One (S (T T_PROCEDURE) :: r1298) + | 2482 -> One (S (T T_PROCEDURE) :: r1307) + | 3648 -> One (S (T T_POINTER) :: r1886) + | 3721 -> One (S (T T_POINTER) :: r1912) + | 335 -> One (S (T T_PICTURE) :: r208) + | 32 -> One (S (T T_PERIOD) :: r43) + | 98 -> One (S (T T_PERIOD) :: r69) + | 114 -> One (S (T T_PERIOD) :: r82) + | 162 -> One (S (T T_PERIOD) :: r110) + | 180 -> One (S (T T_PERIOD) :: r122) + | 193 -> One (S (T T_PERIOD) :: r128) + | 272 -> One (S (T T_PERIOD) :: r167) + | 428 -> One (S (T T_PERIOD) :: r247) + | 434 -> One (S (T T_PERIOD) :: r248) + | 468 -> One (S (T T_PERIOD) :: r266) + | 482 -> One (S (T T_PERIOD) :: r272) + | 632 -> One (S (T T_PERIOD) :: r351) + | 2201 -> One (S (T T_PERIOD) :: r1110) + | 3775 -> One (S (T T_PERIOD) :: r1926) + | 3799 -> One (S (T T_PERIOD) :: r1935) + | 3808 -> One (S (T T_PERIOD) :: r1938) + | 3944 -> One (S (T T_PERIOD) :: r2024) + | 3952 -> One (S (T T_PERIOD) :: r2027) + | 3978 -> One (S (T T_PERIOD) :: r2028) + | 1887 -> One (S (T T_PAGE) :: r976) + | 1936 -> One (S (T T_PAGE) :: r1004) + | 3438 -> One (S (T T_OTHER) :: r1814) + | 490 -> One (S (T T_ONLY) :: r282) + | 1301 -> One (S (T T_OMITTED) :: r671) + | 1596 -> One (S (T T_OMITTED) :: r813) + | 2797 -> One (S (T T_OMITTED) :: r1500) + | 842 -> One (S (T T_OF) :: r480) + | 913 -> One (S (T T_OF) :: r506) + | 1570 -> One (S (T T_OF) :: r794) + | 1712 -> One (S (T T_OCCURS) :: r879) + | 3064 -> One (S (T T_NOT_ON_EXCEPTION) :: r1648) + | 1185 -> One (S (T T_NO) :: r617) + | 2752 -> One (S (T T_NO) :: r1473) + | 3369 -> One (S (T T_NO) :: r1781) + | 2012 -> One (S (T T_NEXT_PAGE) :: r1035) + | 2018 -> One (S (T T_NEXT_PAGE) :: r1036) + | 238 -> One (S (T T_NATIONAL) :: r150) + | 243 | 264 -> One (S (T T_NATIONAL) :: r161) + | 546 -> One (S (T T_LOCK) :: r319) + | 2363 -> One (S (T T_LOCK) :: r1215) + | 2364 -> One (S (T T_LOCK) :: r1216) + | 2367 -> One (S (T T_LOCK) :: r1217) + | 2693 -> One (S (T T_LOCK) :: r1436) + | 3092 -> One (S (T T_LOCK) :: r1663) + | 2626 -> One (S (T T_LINE) :: r1386) + | 308 -> One (S (T T_LENGTH) :: r193) + | 1472 -> One (S (T T_LENGTH) :: r757) + | 1684 -> One (S (T T_LENGTH) :: r856) + | 3613 -> One (S (T T_LENGTH) :: r1878) + | 1692 -> One (S (T T_KEY) :: r862) + | 1703 -> One (S (T T_KEY) :: r870) + | 1707 -> One (S (T T_KEY) :: r873) + | 3051 -> One (S (T T_KEY) :: r1637) + | 610 -> One (S (T T_IS) :: r347) + | 455 -> One (S (T T_INTRINSIC) :: r261) + | 1755 -> One (S (T T_INPUT) :: r905) + | 1803 -> One (S (T T_HEADING) :: r939) + | 1859 -> One (S (T T_HEADING) :: r965) + | 1864 -> One (S (T T_HEADING) :: r966) + | 1868 -> One (S (T T_HEADING) :: r967) + | 3603 -> One (S (T T_GT) :: r640) + | 1318 -> One (S (T T_GT) :: r650) + | 1319 -> One (S (T T_GT) :: r654) + | 1929 -> One (S (T T_GROUP) :: r1000) + | 3291 -> One (S (T T_GIVING) :: r1751) + | 3406 -> One (S (T T_GIVING) :: r1796) + | 3464 -> One (S (T T_GIVING) :: r1821) + | 3697 -> One (S (T T_GIVING) :: r1903) + | 1043 -> One (S (T T_FROM) :: r561) + | 2355 -> One (S (T T_FOREVER) :: r1211) + | 2851 -> One (S (T T_FOR) :: r1524) + | 1642 -> One (S (T T_FOOTING) :: r833) + | 102 -> One (S (T T_FINAL) :: r70) + | 717 -> One (S (T T_FINAL) :: r407) + | 728 -> One (S (T T_FINAL) :: r412) + | 1181 -> One (S (T T_FINAL) :: r615) + | 2879 -> One (S (T T_FILLER) :: r1539) + | 671 -> One (S (T T_FILE) :: r379) + | 2215 -> One (S (T T_EXCEPTION) :: r1127) + | 2232 -> One (S (T T_EXCEPTION) :: r1134) + | 2249 -> One (S (T T_EXCEPTION) :: r1147) + | 2250 -> One (S (T T_EXCEPTION) :: r1151) + | 2293 -> One (S (T T_EXCEPTION) :: r1175) + | 2535 -> One (S (T T_EXCEPTION) :: r1334) + | 1066 -> One (S (T T_ERROR) :: r574) + | 1207 -> One (S (T T_EQUAL) :: r639) + | 1214 -> One (S (T T_EQUAL) :: r643) + | 1225 -> One (S (T T_EQUAL) :: r647) + | 1235 -> One (S (T T_EQUAL) :: r653) + | 1242 -> One (S (T T_EQUAL) :: r657) + | 1253 -> One (S (T T_EQUAL) :: r661) + | 1260 -> One (S (T T_EQUAL) :: r664) + | 1292 -> One (S (T T_EQUAL) :: r668) + | 3552 -> One (S (T T_EQUAL) :: r1846) + | 3995 -> One (S (T T_EOF) :: r2037) + | 2292 -> One (S (T T_EC) :: r1171) + | 583 -> One (S (T T_DUPLICATES) :: r334) + | 2491 -> One (S (T T_DUPLICATES) :: r1311) + | 2503 -> One (S (T T_DUPLICATES) :: r1318) + | 1 -> One (S (T T_DIVISION) :: r2) + | 28 -> One (S (T T_DIVISION) :: r20) + | 174 -> One (S (T T_DIVISION) :: r114) + | 706 -> One (S (T T_DIVISION) :: r386) + | 734 -> One (S (T T_DIVISION) :: r421) + | 2170 -> One (S (T T_DIVISION) :: r1086) + | 3927 -> One (S (T T_DIVISION) :: r2015) + | 1794 -> One (S (T T_DETAIL) :: r935) + | 1799 | 1809 -> One (S (T T_DETAIL) :: r938) + | 1688 -> One (S (T T_DESTINATION) :: r859) + | 2973 -> One (S (T T_DEPENDING) :: r1586) + | 186 -> One (S (T T_DEBUGGING) :: r126) + | 2318 -> One (S (T T_DEBUGGING) :: r1190) + | 1696 -> One (S (T T_DATE) :: r865) + | 1747 -> One (S (T T_COUNT) :: r899) + | 2267 -> One (S (T T_CONDITION) :: r1159) + | 2302 -> One (S (T T_CONDITION) :: r1180) + | 1823 -> One (S (T T_COLUMNS) :: r946) + | 1826 -> One (S (T T_COLUMNS) :: r947) + | 1021 -> One (S (T T_COLON) :: r553) + | 651 -> One (S (T T_CLOCK_UNITS) :: r364) + | 241 -> One (S (T T_CLASSIFICATION) :: r158) + | 3126 -> One (S (T T_CHARACTERS) :: r1687) + | 2593 -> One (S (T T_BY) :: r1368) + | 2822 -> One (S (T T_BY) :: r1512) + | 2840 -> One (S (T T_BY) :: r1521) + | 1600 -> One (S (T T_BIT) :: r815) + | 2336 -> One (S (T T_BEFORE) :: r1200) + | 2508 -> One (S (T T_ASCENDING) :: r1321) + | 1174 -> One (S (T T_AS) :: r611) + | 1942 -> One (S (T T_ARE) :: r1006) + | 59 -> One (S (T T_AMPERSAND) :: r54) + | 355 -> One (S (T T_AMPERSAND) :: r222) + | 868 -> One (S (T T_AMPERSAND) :: r489) + | 2422 -> One (S (T T_AMPERSAND) :: r1255) + | 221 | 235 -> One (S (T T_ALPHANUMERIC) :: r147) + | 261 -> One (S (T T_ALPHANUMERIC) :: r164) + | 278 -> One (S (T T_ALPHANUMERIC) :: r172) + | 452 -> One (S (T T_ALL) :: r260) + | 2643 -> One (S (T T_ALL) :: r1401) + | 3378 -> One (S (T T_ADVANCING) :: r1783) + | 1106 -> One (S (T T_ACTIVE_CLASS) :: r588) + | 1048 -> One (S (N N_subscripts) :: r562) + | 855 | 1045 -> One (S (N N_subscript_first) :: r483) + | 2450 -> One (S (N N_ro_with_status_) :: r1281) + | 2742 -> One (S (N N_ro_sharing_phrase_) :: r1468) + | 2961 -> One (S (N N_ro_raising_exception_) :: r1580) + | 2987 -> One (S (N N_ro_raising_exception_) :: r1590) + | 2993 -> One (S (N N_ro_raising_exception_) :: r1592) + | 2995 -> One (S (N N_ro_raising_exception_) :: r1593) + | 1087 -> One (S (N N_ro_pf_option_TO__name__) :: r580) + | 1092 -> One (S (N N_ro_pf_option_TO__name__) :: r582) + | 1179 -> One (S (N N_ro_pf___anonymous_44_property_kind__) :: r614) + | 1626 -> One (S (N N_ro_pf___anonymous_30_qualname_or_integer__) :: r823) + | 2392 -> One (S (N N_ro_pf___anonymous_100_ident__) :: r1234) + | 3572 -> One (S (N N_ro_pf_VARYING_ident__) :: r1865) + | 352 -> One (S (N N_ro_pf_THROUGH_string_or_int_literal__) :: r217) + | 678 -> One (S (N N_ro_pf_POSITION_integer__) :: r380) + | 634 -> One (S (N N_ro_pf_ON_name__) :: r356) + | 794 -> One (S (N N_ro_pf_FROM_expression__) :: r460) + | 113 -> One (S (N N_ro_options_paragraph_) :: r80) + | 3847 -> One (S (N N_ro_options_paragraph_) :: r1946) + | 3980 -> One (S (N N_ro_options_paragraph_) :: r2036) + | 3386 -> One (S (N N_ro_loc_upon__) :: r1788) + | 789 -> One (S (N N_ro_loc_entry_name_clause__) :: r457) + | 1845 -> One (S (N N_ro_loc_entry_name_clause__) :: r958) + | 2057 -> One (S (N N_ro_loc_entry_name_clause__) :: r1049) + | 2211 -> One (S (N N_ro_integer_) :: r1121) + | 3790 -> One (S (N N_ro_integer_) :: r1932) + | 3886 -> One (S (N N_ro_instance_definition_) :: r1978) + | 2467 -> One (S (N N_ro_collating_sequence_phrase_) :: r1291) + | 3082 -> One (S (N N_ro_close_format_) :: r1659) + | 1360 -> One (S (N N_ro_capacity_phrase_) :: r700) + | 2815 -> One (S (N N_rnell_rev_tallying_) :: r1507) + | 2518 -> One (S (N N_rnell_rev___anonymous_88_) :: r1324) + | 1070 -> One (S (N N_rnel_validation_stage_) :: r575) + | 3075 -> One (S (N N_rnel_rounded_ident_) :: r1656) + | 3304 -> One (S (N N_rnel_rounded_ident_) :: r1758) + | 2739 -> One (S (N N_rnel_open_phrase_) :: r1465) + | 2172 -> One (S (N N_rnel_loc_using_clause__) :: r1091) + | 3929 -> One (S (N N_rnel_loc_using_clause__) :: r2020) + | 2795 -> One (S (N N_rnel_loc_using_by__) :: r1499) + | 2818 -> One (S (N N_rnel_loc_replacing_phrase__) :: r1508) + | 2006 -> One (S (N N_rnel_line_position_) :: r1032) + | 3097 -> One (S (N N_rnel_ident_or_string_) :: r1665) + | 2436 -> One (S (N N_rnel_ident_or_numeric_) :: r1261) + | 3130 -> One (S (N N_rnel_ident_or_numeric_) :: r1691) + | 2819 -> One (S (N N_rnel_ident_by_after_before_) :: r1509) + | 2838 -> One (S (N N_rnel_ident_by_after_before_) :: r1518) + | 2844 -> One (S (N N_rnel_ident_by_after_before_) :: r1522) + | 2273 -> One (S (N N_rl_pf_FILE_name__) :: r1161) + | 1832 -> One (S (N N_rl_name_) :: r950) + | 1837 -> One (S (N N_rl_name_) :: r953) + | 3939 -> One (S (N N_rl_loc_section_paragraph__) :: r2021) + | 657 -> One (S (N N_rl_loc_same_area_clause__) :: r369) + | 196 -> One (S (N N_rl_loc_object_computer_clause__) :: r130) + | 1756 -> One (S (N N_rl_loc_communication_descr_clause__) :: r909) + | 2859 -> One (S (N N_rl_inspect_where_) :: r1531) + | 3602 -> One (S (N N_relop) :: r1874) + | 523 -> One (S (N N_qualname) :: r299) + | 1527 -> One (S (N N_qualname) :: r768) + | 2438 -> One (S (N N_qualname) :: r1268) + | 3131 -> One (S (N N_qualname) :: r1695) + | 2464 -> One (S (N N_qualident) :: r1290) + | 1908 -> One (S (N N_ntl_arithmetic_term_) :: r986) + | 2193 -> One (S (N N_nel_loc___anonymous_72__) :: r1103) + | 2902 -> One (S (N N_nel___anonymous_84_) :: r1546) + | 3080 -> One (S (N N_nel___anonymous_80_) :: r1658) + | 792 -> One (S (N N_nel___anonymous_42_) :: r458) + | 283 -> One (S (N N_name) :: r173) + | 302 -> One (S (N N_name) :: r186) + | 345 -> One (S (N N_name) :: r216) + | 366 -> One (S (N N_name) :: r228) + | 436 -> One (S (N N_name) :: r250) + | 439 -> One (S (N N_name) :: r252) + | 442 -> One (S (N N_name) :: r255) + | 445 -> One (S (N N_name) :: r258) + | 459 -> One (S (N N_name) :: r265) + | 565 -> One (S (N N_name) :: r325) + | 613 -> One (S (N N_name) :: r348) + | 635 -> One (S (N N_name) :: r357) + | 740 -> One (S (N N_name) :: r428) + | 803 -> One (S (N N_name) :: r463) + | 809 -> One (S (N N_name) :: r467) + | 812 -> One (S (N N_name) :: r468) + | 911 -> One (S (N N_name) :: r504) + | 1090 -> One (S (N N_name) :: r581) + | 1102 -> One (S (N N_name) :: r587) + | 1177 -> One (S (N N_name) :: r612) + | 1353 -> One (S (N N_name) :: r690) + | 1445 -> One (S (N N_name) :: r740) + | 1537 -> One (S (N N_name) :: r776) + | 1542 -> One (S (N N_name) :: r782) + | 1568 -> One (S (N N_name) :: r792) + | 1680 -> One (S (N N_name) :: r853) + | 1781 -> One (S (N N_name) :: r919) + | 2173 -> One (S (N N_name) :: r1092) + | 2183 -> One (S (N N_name) :: r1100) + | 2197 -> One (S (N N_name) :: r1105) + | 2268 -> One (S (N N_name) :: r1160) + | 2274 -> One (S (N N_name) :: r1163) + | 2288 -> One (S (N N_name) :: r1169) + | 2303 -> One (S (N N_name) :: r1181) + | 2314 -> One (S (N N_name) :: r1187) + | 2346 -> One (S (N N_name) :: r1208) + | 2410 -> One (S (N N_name) :: r1243) + | 2461 -> One (S (N N_name) :: r1287) + | 2615 -> One (S (N N_name) :: r1380) + | 2657 -> One (S (N N_name) :: r1414) + | 2671 -> One (S (N N_name) :: r1420) + | 2675 -> One (S (N N_name) :: r1426) + | 2684 -> One (S (N N_name) :: r1434) + | 2706 -> One (S (N N_name) :: r1443) + | 2709 -> One (S (N N_name) :: r1444) + | 2784 -> One (S (N N_name) :: r1492) + | 2965 -> One (S (N N_name) :: r1582) + | 2981 -> One (S (N N_name) :: r1587) + | 3037 -> One (S (N N_name) :: r1625) + | 3069 -> One (S (N N_name) :: r1652) + | 3122 -> One (S (N N_name) :: r1683) + | 3240 -> One (S (N N_name) :: r1728) + | 3372 -> One (S (N N_name) :: r1782) + | 867 -> One (S (N N_literal) :: r487) + | 1558 -> One (S (N N_literal) :: r788) + | 1998 -> One (S (N N_literal) :: r1027) + | 2449 -> One (S (N N_literal) :: r1280) + | 3113 -> One (S (N N_l_loc___anonymous_79__) :: r1675) + | 498 -> One (S (N N_integer) :: r285) + | 679 -> One (S (N N_integer) :: r381) + | 748 -> One (S (N N_integer) :: r440) + | 751 -> One (S (N N_integer) :: r442) + | 753 -> One (S (N N_integer) :: r444) + | 768 -> One (S (N N_integer) :: r449) + | 1359 -> One (S (N N_integer) :: r694) + | 1365 -> One (S (N N_integer) :: r703) + | 1368 -> One (S (N N_integer) :: r704) + | 1400 -> One (S (N N_integer) :: r721) + | 1613 -> One (S (N N_integer) :: r821) + | 1915 -> One (S (N N_integer) :: r992) + | 1917 -> One (S (N N_integer) :: r996) + | 1921 -> One (S (N N_integer) :: r997) + | 1932 -> One (S (N N_integer) :: r1001) + | 1934 -> One (S (N N_integer) :: r1002) + | 2007 -> One (S (N N_integer) :: r1033) + | 2009 -> One (S (N N_integer) :: r1034) + | 2025 -> One (S (N N_integer) :: r1039) + | 2027 -> One (S (N N_integer) :: r1040) + | 2070 -> One (S (N N_integer) :: r1055) + | 2371 -> One (S (N N_imp_stmts) :: r1218) + | 2409 -> One (S (N N_imp_stmts) :: r1241) + | 2442 -> One (S (N N_imp_stmts) :: r1270) + | 2448 -> One (S (N N_imp_stmts) :: r1279) + | 2463 -> One (S (N N_imp_stmts) :: r1288) + | 2656 -> One (S (N N_imp_stmts) :: r1407) + | 2683 -> One (S (N N_imp_stmts) :: r1427) + | 2704 -> One (S (N N_imp_stmts) :: r1441) + | 2738 -> One (S (N N_imp_stmts) :: r1464) + | 2775 -> One (S (N N_imp_stmts) :: r1480) + | 2958 -> One (S (N N_imp_stmts) :: r1578) + | 3062 -> One (S (N N_imp_stmts) :: r1643) + | 3073 -> One (S (N N_imp_stmts) :: r1653) + | 3079 -> One (S (N N_imp_stmts) :: r1657) + | 3112 -> One (S (N N_imp_stmts) :: r1674) + | 3135 -> One (S (N N_imp_stmts) :: r1697) + | 3138 -> One (S (N N_imp_stmts) :: r1704) + | 3201 -> One (S (N N_imp_stmts) :: r1705) + | 3216 -> One (S (N N_imp_stmts) :: r1719) + | 3219 -> One (S (N N_imp_stmts) :: r1721) + | 3221 -> One (S (N N_imp_stmts) :: r1722) + | 3234 -> One (S (N N_imp_stmts) :: r1725) + | 3244 -> One (S (N N_imp_stmts) :: r1732) + | 3247 -> One (S (N N_imp_stmts) :: r1734) + | 3266 -> One (S (N N_imp_stmts) :: r1739) + | 3270 -> One (S (N N_imp_stmts) :: r1741) + | 3272 -> One (S (N N_imp_stmts) :: r1742) + | 3281 -> One (S (N N_imp_stmts) :: r1745) + | 3284 -> One (S (N N_imp_stmts) :: r1747) + | 3294 -> One (S (N N_imp_stmts) :: r1753) + | 3297 -> One (S (N N_imp_stmts) :: r1755) + | 3306 -> One (S (N N_imp_stmts) :: r1760) + | 3309 -> One (S (N N_imp_stmts) :: r1762) + | 3321 -> One (S (N N_imp_stmts) :: r1764) + | 3324 -> One (S (N N_imp_stmts) :: r1765) + | 3331 -> One (S (N N_imp_stmts) :: r1766) + | 3338 -> One (S (N N_imp_stmts) :: r1767) + | 3341 -> One (S (N N_imp_stmts) :: r1768) + | 3343 -> One (S (N N_imp_stmts) :: r1769) + | 3354 -> One (S (N N_imp_stmts) :: r1773) + | 3357 -> One (S (N N_imp_stmts) :: r1775) + | 3363 -> One (S (N N_imp_stmts) :: r1778) + | 3400 -> One (S (N N_imp_stmts) :: r1791) + | 3412 -> One (S (N N_imp_stmts) :: r1799) + | 3415 -> One (S (N N_imp_stmts) :: r1801) + | 3427 -> One (S (N N_imp_stmts) :: r1809) + | 3430 -> One (S (N N_imp_stmts) :: r1811) + | 3458 -> One (S (N N_imp_stmts) :: r1817) + | 3467 -> One (S (N N_imp_stmts) :: r1823) + | 3470 -> One (S (N N_imp_stmts) :: r1825) + | 3495 -> One (S (N N_imp_stmts) :: r1832) + | 3498 -> One (S (N N_imp_stmts) :: r1833) + | 3500 -> One (S (N N_imp_stmts) :: r1834) + | 3508 -> One (S (N N_imp_stmts) :: r1835) + | 3510 -> One (S (N N_imp_stmts) :: r1836) + | 3523 -> One (S (N N_imp_stmts) :: r1837) + | 3527 -> One (S (N N_imp_stmts) :: r1838) + | 3531 -> One (S (N N_imp_stmts) :: r1839) + | 3538 -> One (S (N N_imp_stmts) :: r1840) + | 3562 -> One (S (N N_imp_stmts) :: r1854) + | 3585 -> One (S (N N_imp_stmts) :: r1870) + | 3593 -> One (S (N N_imp_stmts) :: r1871) + | 3596 -> One (S (N N_imp_stmts) :: r1872) + | 3606 -> One (S (N N_imp_stmts) :: r1875) + | 3609 -> One (S (N N_imp_stmts) :: r1876) + | 3616 -> One (S (N N_imp_stmts) :: r1879) + | 3619 -> One (S (N N_imp_stmts) :: r1880) + | 3627 -> One (S (N N_imp_stmts) :: r1881) + | 3631 -> One (S (N N_imp_stmts) :: r1882) + | 3634 -> One (S (N N_imp_stmts) :: r1883) + | 3645 -> One (S (N N_imp_stmts) :: r1884) + | 3651 -> One (S (N N_imp_stmts) :: r1887) + | 3655 -> One (S (N N_imp_stmts) :: r1888) + | 3657 -> One (S (N N_imp_stmts) :: r1889) + | 3662 -> One (S (N N_imp_stmts) :: r1890) + | 3679 -> One (S (N N_imp_stmts) :: r1894) + | 3688 -> One (S (N N_imp_stmts) :: r1897) + | 3691 -> One (S (N N_imp_stmts) :: r1899) + | 3700 -> One (S (N N_imp_stmts) :: r1905) + | 3703 -> One (S (N N_imp_stmts) :: r1907) + | 3712 -> One (S (N N_imp_stmts) :: r1909) + | 3717 -> One (S (N N_imp_stmts) :: r1910) + | 3727 -> One (S (N N_imp_stmts) :: r1915) + | 3731 -> One (S (N N_imp_stmts) :: r1916) + | 3736 -> One (S (N N_imp_stmts) :: r1917) + | 3740 -> One (S (N N_imp_stmts) :: r1918) + | 3745 -> One (S (N N_imp_stmts) :: r1919) + | 3753 -> One (S (N N_imp_stmts) :: r1920) + | 3759 -> One (S (N N_imp_stmts) :: r1921) + | 3761 -> One (S (N N_imp_stmts) :: r1922) + | 3769 -> One (S (N N_imp_stmts) :: r1923) + | 3771 -> One (S (N N_imp_stmts) :: r1924) + | 2372 -> One (S (N N_idents) :: r1219) + | 2556 -> One (S (N N_idents) :: r1348) + | 2567 -> One (S (N N_idents) :: r1355) + | 2877 -> One (S (N N_idents) :: r1538) + | 844 -> One (S (N N_ident_or_literal) :: r481) + | 2093 -> One (S (N N_ident_or_literal) :: r1064) + | 2349 -> One (S (N N_ident_or_literal) :: r1209) + | 2776 -> One (S (N N_ident_or_literal) :: r1483) + | 3063 -> One (S (N N_ident_or_literal) :: r1645) + | 2062 -> One (S (N N_ident) :: r1052) + | 2065 -> One (S (N N_ident) :: r1053) + | 2374 -> One (S (N N_ident) :: r1223) + | 2415 -> One (S (N N_ident) :: r1253) + | 2660 -> One (S (N N_ident) :: r1415) + | 2690 -> One (S (N N_ident) :: r1435) + | 2705 -> One (S (N N_ident) :: r1442) + | 2777 -> One (S (N N_ident) :: r1486) + | 2791 -> One (S (N N_ident) :: r1498) + | 2813 -> One (S (N N_ident) :: r1506) + | 2962 -> One (S (N N_ident) :: r1581) + | 3136 -> One (S (N N_ident) :: r1699) + | 3409 -> One (S (N N_ident) :: r1797) + | 3573 -> One (S (N N_ident) :: r1866) + | 816 -> One (S (N N_function_name) :: r469) + | 829 -> One (S (N N_expression_no_all) :: r474) + | 832 -> One (S (N N_expression_no_all) :: r477) + | 993 -> One (S (N N_expression_no_all) :: r543) + | 1016 -> One (S (N N_expression_no_all) :: r550) + | 795 -> One (S (N N_expression) :: r461) + | 1035 -> One (S (N N_expression) :: r556) + | 1191 -> One (S (N N_expression) :: r626) + | 1196 -> One (S (N N_expression) :: r634) + | 1299 -> One (S (N N_expression) :: r670) + | 1320 -> One (S (N N_expression) :: r676) + | 2357 -> One (S (N N_expression) :: r1213) + | 3004 -> One (S (N N_expression) :: r1614) + | 3020 -> One (S (N N_expression) :: r1618) + | 2985 -> One (S (N N_exit_spec) :: r1589) + | 3029 -> One (S (N N_class_condition_no_ident) :: r1622) + | 831 -> One (S (N N_atomic_expression_no_all) :: r475) + | 839 -> One (S (N N_atomic_expression_no_all) :: r478) + | 856 -> One (S (N N_atomic_expression_no_all) :: r484) + | 801 -> One (S (N N_atomic_expression) :: r462) + | 935 -> One (S (N N_atomic_expression) :: r519) + | 945 -> One (S (N N_atomic_expression) :: r520) + | 457 -> One (Sub (r22) :: r262) + | 1415 -> One (Sub (r22) :: r724) + | 1425 -> One (Sub (r22) :: r729) + | 31 -> One (Sub (r28) :: r37) + | 36 -> One (Sub (r45) :: r46) + | 45 -> One (Sub (r48) :: r49) + | 56 -> One (Sub (r48) :: r50) + | 70 -> One (Sub (r52) :: r55) + | 86 -> One (Sub (r57) :: r60) + | 109 -> One (Sub (r57) :: r73) + | 1903 -> One (Sub (r57) :: r985) + | 2431 -> One (Sub (r57) :: r1256) + | 2469 -> One (Sub (r57) :: r1292) + | 2875 -> One (Sub (r57) :: r1537) + | 2983 -> One (Sub (r57) :: r1588) + | 3858 -> One (Sub (r57) :: r1963) + | 3864 -> One (Sub (r57) :: r1965) + | 1608 -> One (Sub (r141) :: r818) + | 353 -> One (Sub (r219) :: r220) + | 379 -> One (Sub (r219) :: r229) + | 381 -> One (Sub (r219) :: r230) + | 395 -> One (Sub (r233) :: r234) + | 709 -> One (Sub (r393) :: r402) + | 884 -> One (Sub (r493) :: r497) + | 888 -> One (Sub (r493) :: r498) + | 892 -> One (Sub (r493) :: r499) + | 894 -> One (Sub (r493) :: r500) + | 896 -> One (Sub (r493) :: r501) + | 898 -> One (Sub (r493) :: r502) + | 920 -> One (Sub (r493) :: r507) + | 1003 -> One (Sub (r493) :: r544) + | 1008 -> One (Sub (r493) :: r545) + | 882 -> One (Sub (r495) :: r496) + | 901 -> One (Sub (r495) :: r503) + | 928 -> One (Sub (r509) :: r511) + | 983 -> One (Sub (r509) :: r536) + | 948 -> One (Sub (r515) :: r521) + | 952 -> One (Sub (r515) :: r522) + | 954 -> One (Sub (r515) :: r523) + | 956 -> One (Sub (r515) :: r524) + | 958 -> One (Sub (r515) :: r525) + | 960 -> One (Sub (r515) :: r526) + | 966 -> One (Sub (r515) :: r528) + | 968 -> One (Sub (r515) :: r529) + | 970 -> One (Sub (r515) :: r530) + | 972 -> One (Sub (r515) :: r531) + | 974 -> One (Sub (r515) :: r532) + | 978 -> One (Sub (r515) :: r533) + | 934 -> One (Sub (r517) :: r518) + | 963 -> One (Sub (r517) :: r527) + | 1027 -> One (Sub (r517) :: r554) + | 1029 -> One (Sub (r517) :: r555) + | 1121 -> One (Sub (r594) :: r595) + | 1126 -> One (Sub (r594) :: r596) + | 1128 -> One (Sub (r594) :: r597) + | 1145 -> One (Sub (r599) :: r600) + | 1151 -> One (Sub (r599) :: r601) + | 1153 -> One (Sub (r599) :: r602) + | 1155 -> One (Sub (r599) :: r603) + | 1199 -> One (Sub (r621) :: r636) + | 1307 -> One (Sub (r621) :: r672) + | 1310 -> One (Sub (r621) :: r673) + | 1315 -> One (Sub (r621) :: r675) + | 2953 -> One (Sub (r623) :: r1576) + | 1195 -> One (Sub (r632) :: r633) + | 1324 -> One (Sub (r632) :: r677) + | 1326 -> One (Sub (r632) :: r678) + | 1330 -> One (Sub (r632) :: r679) + | 1337 -> One (Sub (r632) :: r680) + | 1339 -> One (Sub (r632) :: r681) + | 1451 -> One (Sub (r743) :: r745) + | 1954 -> One (Sub (r743) :: r749) + | 1491 -> One (Sub (r759) :: r761) + | 1591 -> One (Sub (r809) :: r811) + | 1874 -> One (Sub (r970) :: r971) + | 1880 -> One (Sub (r970) :: r972) + | 1885 -> One (Sub (r970) :: r975) + | 1890 -> One (Sub (r970) :: r978) + | 1944 -> One (Sub (r1008) :: r1009) + | 1955 -> One (Sub (r1014) :: r1015) + | 2000 -> One (Sub (r1029) :: r1031) + | 2084 -> One (Sub (r1057) :: r1063) + | 2098 -> One (Sub (r1068) :: r1069) + | 2177 -> One (Sub (r1098) :: r1099) + | 2330 -> One (Sub (r1194) :: r1195) + | 2711 -> One (Sub (r1194) :: r1446) + | 3480 -> One (Sub (r1194) :: r1827) + | 2334 -> One (Sub (r1196) :: r1197) + | 2345 -> One (Sub (r1202) :: r1207) + | 2649 -> One (Sub (r1202) :: r1406) + | 2869 -> One (Sub (r1245) :: r1536) + | 3242 -> One (Sub (r1245) :: r1730) + | 2443 -> One (Sub (r1275) :: r1278) + | 2451 -> One (Sub (r1283) :: r1286) + | 2475 -> One (Sub (r1294) :: r1299) + | 2481 -> One (Sub (r1302) :: r1303) + | 2497 -> One (Sub (r1302) :: r1312) + | 2519 -> One (Sub (r1326) :: r1331) + | 2586 -> One (Sub (r1352) :: r1362) + | 2577 -> One (Sub (r1360) :: r1361) + | 2592 -> One (Sub (r1365) :: r1367) + | 2601 -> One (Sub (r1374) :: r1375) + | 2619 -> One (Sub (r1382) :: r1385) + | 2639 -> One (Sub (r1382) :: r1392) + | 3549 -> One (Sub (r1394) :: r1843) + | 2726 -> One (Sub (r1450) :: r1462) + | 2767 -> One (Sub (r1450) :: r1478) + | 3058 -> One (Sub (r1450) :: r1641) + | 3422 -> One (Sub (r1450) :: r1807) + | 2716 -> One (Sub (r1457) :: r1459) + | 2718 -> One (Sub (r1457) :: r1461) + | 2853 -> One (Sub (r1529) :: r1530) + | 2861 -> One (Sub (r1529) :: r1532) + | 2998 -> One (Sub (r1597) :: r1605) + | 3446 -> One (Sub (r1597) :: r1815) + | 3002 -> One (Sub (r1609) :: r1610) + | 3018 -> One (Sub (r1609) :: r1617) + | 3041 -> One (Sub (r1630) :: r1631) + | 3067 -> One (Sub (r1630) :: r1649) + | 3102 -> One (Sub (r1667) :: r1670) + | 3105 -> One (Sub (r1672) :: r1673) + | 3205 -> One (Sub (r1711) :: r1713) + | 3352 -> One (Sub (r1711) :: r1771) + | 3855 -> One (Sub (r1950) :: r1958) + | 3892 -> One (Sub (r1979) :: r1973) + | 24 -> One (r0) + | 3 -> One (r1) + | 2 -> One (r2) + | 13 -> One (r3) + | 22 -> One (r5) + | 6 -> One (r6) + | 5 -> One (r7) + | 11 -> One (r8) + | 12 -> One (r10) + | 9 -> One (r11) + | 19 -> One (r12) + | 18 -> One (r13) + | 17 -> One (r14) + | 16 -> One (r15) + | 3966 -> One (r16) + | 3965 -> One (r17) + | 27 -> One (r18) + | 30 -> One (r19) + | 29 -> One (r20) + | 74 -> One (r21) + | 94 -> One (r23) + | 93 -> One (r24) + | 92 -> One (r25) + | 91 -> One (r26) + | 90 -> One (r27) + | 3846 -> One (r29) + | 3845 -> One (r30) + | 3844 -> One (r31) + | 3843 -> One (r32) + | 3842 -> One (r33) + | 3841 -> One (r34) + | 3840 -> One (r35) + | 3839 -> One (r36) + | 3838 -> One (r37) + | 89 -> One (r38) + | 88 -> One (r39) + | 85 -> One (r40) + | 76 -> One (r41) + | 35 -> One (r42) + | 33 -> One (r43) + | 73 -> One (r44) + | 72 -> One (r46) + | 51 | 850 -> One (r47) + | 55 -> One (r49) + | 57 -> One (r50) + | 68 | 351 -> One (r51) + | 69 -> One (r53) + | 60 -> One (r54) + | 71 -> One (r55) + | 80 -> One (r56) + | 82 -> One (r58) + | 79 -> One (r59) + | 87 -> One (r60) + | 97 -> One (r61) + | 96 -> One (r62) + | 112 -> One (r63) + | 111 -> One (r64) + | 108 -> One (r65) + | 104 -> One (r66) + | 101 -> One (r67) + | 100 -> One (r68) + | 99 -> One (r69) + | 103 -> One (r70) + | 107 -> One (r71) + | 106 -> One (r72) + | 110 -> One (r73) + | 3835 -> One (r74) + | 3834 -> One (r75) + | 3833 -> One (r76) + | 3832 -> One (r77) + | 3831 -> One (r78) + | 705 -> One (r79) + | 173 -> One (r80) + | 172 -> One (r81) + | 115 -> One (r82) + | 126 -> One (r83) + | 127 -> One (r85) + | 118 -> One (r86) + | 117 -> One (r87) + | 135 -> One (r88) + | 138 -> One (r90) + | 140 -> One (r92) + | 131 -> One (r93) + | 130 -> One (r94) + | 133 -> One (r95) + | 144 -> One (r97) + | 143 -> One (r98) + | 142 -> One (r99) + | 147 -> One (r100) + | 146 -> One (r101) + | 153 -> One (r102) + | 152 -> One (r103) + | 151 -> One (r104) + | 149 -> One (r105) + | 159 -> One (r106) + | 160 -> One (r108) + | 155 -> One (r109) + | 163 -> One (r110) + | 700 -> One (r111) + | 478 -> One (r112) + | 176 -> One (r113) + | 175 -> One (r114) + | 471 -> One (r115) + | 433 -> One (r116) + | 271 -> One (r117) + | 192 -> One (r118) + | 179 -> One (r119) + | 178 -> One (r120) + | 183 -> One (r121) + | 181 -> One (r122) + | 190 -> One (r123) + | 189 -> One (r124) + | 188 -> One (r125) + | 187 -> One (r126) + | 195 -> One (r127) + | 194 -> One (r128) + | 215 -> One (r129) + | 214 -> One (r130) + | 202 -> One (r131) + | 198 -> One (r132) + | 210 -> One (r133) + | 211 -> One (r135) + | 207 -> One (r136) + | 206 -> One (r137) + | 230 -> One (r138) + | 229 -> One (r139) + | 228 -> One (r140) + | 240 -> One (r142) + | 220 -> One (r143) + | 219 -> One (r144) + | 227 -> One (r145) + | 226 -> One (r146) + | 225 -> One (r147) + | 224 -> One (r148) + | 223 -> One (r149) + | 222 -> One (r150) + | 249 -> One (r151) + | 256 -> One (r153) + | 255 -> One (r154) + | 254 -> One (r155) + | 259 -> One (r157) + | 242 -> One (r158) + | 250 -> One (r159) + | 245 -> One (r160) + | 244 -> One (r161) + | 253 -> One (r162) + | 252 -> One (r163) + | 251 -> One (r164) + | 268 -> One (r165) + | 430 -> One (r166) + | 273 -> One (r167) + | 285 -> One (r168) + | 282 -> One (r169) + | 281 -> One (r170) + | 276 -> One (r171) + | 280 -> One (r172) + | 284 -> One (r173) + | 291 -> One (r174) + | 293 -> One (r176) + | 290 -> One (r177) + | 301 -> One (r178) + | 300 -> One (r179) + | 299 -> One (r180) + | 298 -> One (r181) + | 307 -> One (r182) + | 306 -> One (r184) + | 304 -> One (r185) + | 303 -> One (r186) + | 317 -> One (r187) + | 316 -> One (r189) + | 313 -> One (r190) + | 312 -> One (r191) + | 311 -> One (r192) + | 309 -> One (r193) + | 321 -> One (r194) + | 320 -> One (r195) + | 324 -> One (r196) + | 323 -> One (r197) + | 327 -> One (r198) + | 326 -> One (r199) + | 333 -> One (r200) + | 332 -> One (r201) + | 331 -> One (r202) + | 330 -> One (r203) + | 340 -> One (r204) + | 339 -> One (r205) + | 338 -> One (r206) + | 337 -> One (r207) + | 336 -> One (r208) + | 344 -> One (r209) + | 343 -> One (r210) + | 342 -> One (r211) + | 365 -> One (r212) + | 364 -> One (r213) + | 348 -> One (r214) + | 347 -> One (r215) + | 346 -> One (r216) + | 361 -> One (r217) + | 359 -> One (r218) + | 354 -> One (r220) + | 357 -> One (r221) + | 356 -> One (r222) + | 386 -> One (r223) + | 390 -> One (r225) + | 369 -> One (r226) + | 368 -> One (r227) + | 367 -> One (r228) + | 380 -> One (r229) + | 382 -> One (r230) + | 414 -> One (r231) + | 413 -> One (r232) + | 418 -> One (r234) + | 400 -> One (r235) + | 399 -> One (r236) + | 398 -> One (r237) + | 404 -> One (r238) + | 403 -> One (r239) + | 402 -> One (r240) + | 408 -> One (r241) + | 407 -> One (r242) + | 406 -> One (r243) + | 412 -> One (r244) + | 411 -> One (r245) + | 410 -> One (r246) + | 429 -> One (r247) + | 435 -> One (r248) + | 438 -> One (r249) + | 437 -> One (r250) + | 441 -> One (r251) + | 440 -> One (r252) + | 449 -> One (r253) + | 444 -> One (r254) + | 443 -> One (r255) + | 448 -> One (r256) + | 447 -> One (r257) + | 446 -> One (r258) + | 454 -> One (r259) + | 453 -> One (r260) + | 456 -> One (r261) + | 458 -> One (r262) + | 462 -> One (r263) + | 461 -> One (r264) + | 460 -> One (r265) + | 469 -> One (r266) + | 695 -> One (r267) + | 631 -> One (r268) + | 481 -> One (r269) + | 480 -> One (r270) + | 629 -> One (r271) + | 483 -> One (r272) + | 625 -> One (r273) + | 624 -> One (r274) + | 487 -> One (r275) + | 486 -> One (r276) + | 496 -> One (r277) + | 495 -> One (r278) + | 497 -> One (r280) + | 489 -> One (r281) + | 491 -> One (r282) + | 494 -> One (r283) + | 502 -> One (r284) + | 499 -> One (r285) + | 507 -> One (r286) + | 506 -> One (r287) + | 505 -> One (r288) + | 519 -> One (r289) + | 515 -> One (r290) + | 514 -> One (r291) + | 513 -> One (r292) + | 511 -> One (r293) + | 512 -> One (r295) + | 510 -> One (r296) + | 518 -> One (r297) + | 517 -> One (r298) + | 524 -> One (r299) + | 531 -> One (r300) + | 530 -> One (r302) + | 527 -> One (r303) + | 526 -> One (r304) + | 536 -> One (r305) + | 537 -> One (r307) + | 533 -> One (r308) + | 539 -> One (r309) + | 544 -> One (r310) + | 553 -> One (r312) + | 545 -> One (r313) + | 542 -> One (r314) + | 541 -> One (r315) + | 552 -> One (r316) + | 550 -> One (r317) + | 548 -> One (r318) + | 547 -> One (r319) + | 557 -> One (r320) + | 556 -> One (r321) + | 567 -> One (r322) + | 564 -> One (r323) + | 561 -> One (r324) + | 566 -> One (r325) + | 585 -> One (r326) + | 582 -> One (r327) + | 578 -> One (r328) + | 577 -> One (r329) + | 576 -> One (r330) + | 575 -> One (r331) + | 581 -> One (r332) + | 580 -> One (r333) + | 584 -> One (r334) + | 591 -> One (r335) + | 592 -> One (r337) + | 588 -> One (r338) + | 587 -> One (r339) + | 605 -> One (r340) + | 604 -> One (r341) + | 603 -> One (r342) + | 609 -> One (r343) + | 608 -> One (r344) + | 607 -> One (r345) + | 612 -> One (r346) + | 611 -> One (r347) + | 615 -> One (r348) + | 628 -> One (r349) + | 692 -> One (r350) + | 633 -> One (r351) + | 650 -> One (r352) + | 649 -> One (r354) + | 639 -> One (r355) + | 637 -> One (r356) + | 636 -> One (r357) + | 648 -> One (r358) + | 647 -> One (r359) + | 646 -> One (r360) + | 642 -> One (r361) + | 645 -> One (r362) + | 644 -> One (r363) + | 655 -> One (r364) + | 654 -> One (r365) + | 653 -> One (r366) + | 685 -> One (r367) + | 684 -> One (r368) + | 670 -> One (r369) + | 667 -> One (r370) + | 666 -> One (r371) + | 665 -> One (r372) + | 664 -> One (r373) + | 662 -> One (r374) + | 669 -> One (r375) + | 677 -> One (r376) + | 676 -> One (r377) + | 674 -> One (r378) + | 672 -> One (r379) + | 681 -> One (r380) + | 680 -> One (r381) + | 687 -> One (r382) + | 691 -> One (r383) + | 3825 -> One (r384) + | 708 -> One (r385) + | 707 -> One (r386) + | 730 -> One (r387) + | 727 -> One (r388) + | 726 -> One (r389) + | 725 -> One (r390) + | 711 -> One (r391) + | 710 -> One (r392) + | 3816 -> One (r394) + | 3815 -> One (r395) + | 3814 -> One (r396) + | 3813 -> One (r397) + | 3812 -> One (r398) + | 2169 -> One (r399) + | 733 -> One (r400) + | 732 -> One (r401) + | 731 -> One (r402) + | 719 -> One (r403) + | 716 -> One (r404) + | 714 -> One (r405) + | 713 -> One (r406) + | 718 -> One (r407) + | 724 -> One (r408) + | 723 -> One (r409) + | 722 -> One (r410) + | 721 -> One (r411) + | 729 -> One (r412) + | 2156 -> One (r413) + | 2053 -> One (r414) + | 1777 -> One (r415) + | 1676 -> One (r416) + | 1671 -> One (r417) + | 1666 -> One (r418) + | 1660 -> One (r419) + | 736 -> One (r420) + | 735 -> One (r421) + | 1656 -> One (r422) + | 739 -> One (r423) + | 738 -> One (r424) + | 1532 -> One (r425) + | 787 -> One (r426) + | 786 -> One (r427) + | 741 -> One (r428) + | 771 -> One (r429) + | 767 -> One (r430) + | 766 -> One (r431) + | 757 -> One (r432) + | 763 -> One (r434) + | 758 -> One (r435) + | 747 -> One (r436) + | 746 -> One (r437) + | 744 -> One (r438) + | 750 -> One (r439) + | 749 -> One (r440) + | 756 -> One (r441) + | 752 -> One (r442) + | 755 -> One (r443) + | 754 -> One (r444) + | 762 -> One (r445) + | 761 -> One (r446) + | 759 -> One (r447) + | 770 -> One (r448) + | 769 -> One (r449) + | 777 -> One (r450) + | 776 -> One (r451) + | 780 -> One (r452) + | 779 -> One (r453) + | 783 -> One (r454) + | 1486 -> One (r455) + | 1485 -> One (r456) + | 791 -> One (r457) + | 793 -> One (r458) + | 1037 -> One (r459) + | 1034 -> One (r460) + | 1033 -> One (r461) + | 1032 -> One (r462) + | 804 -> One (r463) + | 1026 -> One (r464) + | 1025 -> One (r465) + | 806 -> One (r466) + | 810 -> One (r467) + | 813 -> One (r468) + | 824 -> One (r469) + | 828 -> One (r470) + | 1013 -> One (r471) + | 1012 -> One (r472) + | 1011 -> One (r473) + | 1010 -> One (r474) + | 1007 -> One (r475) + | 1006 -> One (r476) + | 1005 -> One (r477) + | 1002 -> One (r478) + | 1001 -> One (r479) + | 843 -> One (r480) + | 999 -> One (r481) + | 924 -> One (r482) + | 923 -> One (r483) + | 919 -> One (r484) + | 863 -> One (r485) + | 906 -> One (r486) + | 871 -> One (r487) + | 870 -> One (r488) + | 869 -> One (r489) + | 873 -> One (r490) + | 876 -> One (r491) + | 887 -> One (r492) + | 900 -> One (r494) + | 883 -> One (r496) + | 885 -> One (r497) + | 889 -> One (r498) + | 893 -> One (r499) + | 895 -> One (r500) + | 897 -> One (r501) + | 899 -> One (r502) + | 902 -> One (r503) + | 917 -> One (r504) + | 915 -> One (r505) + | 914 -> One (r506) + | 921 -> One (r507) + | 930 -> One (r508) + | 932 -> One (r510) + | 931 -> One (r511) + | 950 -> One (r512) + | 947 -> One (r514) + | 962 -> One (r516) + | 951 -> One (r518) + | 943 -> One (r519) + | 946 -> One (r520) + | 949 -> One (r521) + | 953 -> One (r522) + | 955 -> One (r523) + | 957 -> One (r524) + | 959 -> One (r525) + | 961 -> One (r526) + | 964 -> One (r527) + | 967 -> One (r528) + | 969 -> One (r529) + | 971 -> One (r530) + | 973 -> One (r531) + | 975 -> One (r532) + | 979 -> One (r533) + | 981 -> One (r534) + | 985 -> One (r535) + | 984 -> One (r536) + | 989 -> One (r537) + | 988 -> One (r538) + | 987 -> One (r539) + | 997 -> One (r540) + | 996 -> One (r541) + | 995 -> One (r542) + | 994 -> One (r543) + | 1004 -> One (r544) + | 1009 -> One (r545) + | 1015 -> One (r546) + | 1020 -> One (r547) + | 1019 -> One (r548) + | 1018 -> One (r549) + | 1017 -> One (r550) + | 1024 -> One (r551) + | 1023 -> One (r552) + | 1022 -> One (r553) + | 1028 -> One (r554) + | 1030 -> One (r555) + | 1036 -> One (r556) + | 1056 -> One (r557) + | 1042 -> One (r558) + | 1050 -> One (r559) + | 1047 -> One (r560) + | 1044 -> One (r561) + | 1049 -> One (r562) + | 1060 -> One (r563) + | 1058 -> One (r564) + | 1068 -> One (r565) + | 1082 -> One (r567) + | 1079 -> One (r568) + | 1078 -> One (r569) + | 1069 -> One (r570) + | 1065 -> One (r571) + | 1063 -> One (r572) + | 1062 -> One (r573) + | 1067 -> One (r574) + | 1076 -> One (r575) + | 1157 -> One (r576) + | 1158 -> One (r578) + | 1086 -> One (r579) + | 1088 -> One (r580) + | 1091 -> One (r581) + | 1093 -> One (r582) + | 1099 -> One (r583) + | 1096 -> One (r584) + | 1098 -> One (r585) + | 1105 -> One (r586) + | 1103 -> One (r587) + | 1107 -> One (r588) + | 1112 -> One (r589) + | 1111 -> One (r590) + | 1117 -> One (r591) + | 1120 -> One (r592) + | 1122 -> One (r593) + | 1124 -> One (r595) + | 1127 -> One (r596) + | 1129 -> One (r597) + | 1149 -> One (r598) + | 1148 -> One (r600) + | 1152 -> One (r601) + | 1154 -> One (r602) + | 1156 -> One (r603) + | 1161 -> One (r604) + | 1164 -> One (r605) + | 1163 -> One (r606) + | 1169 -> One (r607) + | 1173 -> One (r608) + | 1171 -> One (r609) + | 1176 -> One (r610) + | 1175 -> One (r611) + | 1178 -> One (r612) + | 1183 -> One (r613) + | 1180 -> One (r614) + | 1182 -> One (r615) + | 1188 -> One (r616) + | 1186 -> One (r617) + | 1308 -> One (r618) + | 1200 -> One (r620) + | 1344 -> One (r622) + | 1343 -> One (r624) + | 1190 -> One (r625) + | 1342 -> One (r626) + | 1335 -> One (r627) + | 1334 -> One (r628) + | 1333 -> One (r629) + | 1332 -> One (r630) + | 1329 -> One (r631) + | 1323 -> One (r633) + | 1314 -> One (r634) + | 1306 -> One (r635) + | 1305 -> One (r636) + | 1206 -> One (r637) + | 1209 -> One (r638) + | 1208 -> One (r639) + | 1211 -> One (r640) + | 1213 -> One (r641) + | 1216 -> One (r642) + | 1215 -> One (r643) + | 1219 -> One (r644) + | 1224 -> One (r645) + | 1227 -> One (r646) + | 1226 -> One (r647) + | 1270 -> One (r648) + | 1267 -> One (r649) + | 1257 -> One (r650) + | 1234 -> One (r651) + | 1237 -> One (r652) + | 1236 -> One (r653) + | 1239 -> One (r654) + | 1241 -> One (r655) + | 1244 -> One (r656) + | 1243 -> One (r657) + | 1247 -> One (r658) + | 1252 -> One (r659) + | 1255 -> One (r660) + | 1254 -> One (r661) + | 1259 -> One (r662) + | 1262 -> One (r663) + | 1261 -> One (r664) + | 1265 -> One (r665) + | 1291 -> One (r666) + | 1294 -> One (r667) + | 1293 -> One (r668) + | 1297 -> One (r669) + | 1300 -> One (r670) + | 1302 -> One (r671) + | 1309 -> One (r672) + | 1311 -> One (r673) + | 1317 -> One (r674) + | 1316 -> One (r675) + | 1321 -> One (r676) + | 1325 -> One (r677) + | 1327 -> One (r678) + | 1331 -> One (r679) + | 1338 -> One (r680) + | 1340 -> One (r681) + | 1356 -> One (r682) + | 1355 -> One (r683) + | 1347 -> One (r684) + | 1346 -> One (r685) + | 1352 -> One (r686) + | 1351 -> One (r687) + | 1350 -> One (r688) + | 1349 -> One (r689) + | 1354 -> One (r690) + | 1409 -> One (r691) + | 1408 -> One (r692) + | 1407 -> One (r693) + | 1399 -> One (r694) + | 1390 -> One (r695) + | 1385 -> One (r696) + | 1372 -> One (r697) + | 1370 -> One (r698) + | 1367 -> One (r699) + | 1364 -> One (r700) + | 1363 -> One (r701) + | 1362 -> One (r702) + | 1366 -> One (r703) + | 1369 -> One (r704) + | 1376 -> One (r705) + | 1377 -> One (r707) + | 1375 -> One (r708) + | 1374 -> One (r709) + | 1384 -> One (r710) + | 1383 -> One (r711) + | 1382 -> One (r712) + | 1389 -> One (r713) + | 1388 -> One (r714) + | 1394 -> One (r715) + | 1406 -> One (r717) + | 1405 -> One (r718) + | 1404 -> One (r719) + | 1403 -> One (r720) + | 1401 -> One (r721) + | 1412 -> One (r722) + | 1414 -> One (r723) + | 1416 -> One (r724) + | 1419 -> One (r725) + | 1418 -> One (r726) + | 1424 -> One (r727) + | 1422 -> One (r728) + | 1426 -> One (r729) + | 1434 -> One (r730) + | 1430 -> One (r731) + | 1429 -> One (r732) + | 1433 -> One (r733) + | 1432 -> One (r734) + | 1438 -> One (r735) + | 1437 -> One (r736) + | 1442 -> One (r737) + | 1440 -> One (r738) + | 1444 -> One (r739) + | 1446 -> One (r740) + | 1450 -> One (r741) + | 1447 -> One (r742) + | 1456 -> One (r744) + | 1455 -> One (r745) + | 1454 -> One (r746) + | 1453 -> One (r747) + | 1458 -> One (r748) + | 1457 -> One (r749) + | 1466 -> One (r750) + | 1467 -> One (r752) + | 1460 -> One (r753) + | 1470 -> One (r754) + | 1469 -> One (r755) + | 1468 | 2117 -> One (r756) + | 1473 -> One (r757) + | 1493 -> One (r758) + | 1497 -> One (r760) + | 1494 -> One (r761) + | 1496 -> One (r762) + | 1516 -> One (r763) + | 1530 -> One (r764) + | 1529 -> One (r765) + | 1526 -> One (r766) + | 1525 -> One (r767) + | 1528 -> One (r768) + | 1536 -> One (r769) + | 1565 -> One (r770) + | 1564 -> One (r771) + | 1563 -> One (r772) + | 1562 -> One (r773) + | 1561 -> One (r774) + | 1560 -> One (r775) + | 1538 -> One (r776) + | 1546 -> One (r777) + | 1545 -> One (r778) + | 1544 -> One (r779) + | 1541 -> One (r780) + | 1540 -> One (r781) + | 1543 -> One (r782) + | 1553 -> One (r783) + | 1552 -> One (r784) + | 1551 -> One (r785) + | 1550 -> One (r786) + | 1549 -> One (r787) + | 1559 -> One (r788) + | 1622 -> One (r789) + | 1621 -> One (r790) + | 1620 -> One (r791) + | 1569 -> One (r792) + | 1572 -> One (r793) + | 1571 -> One (r794) + | 1578 -> One (r795) + | 1575 -> One (r797) + | 1574 -> One (r798) + | 1581 -> One (r799) + | 1580 -> One (r800) + | 1584 -> One (r801) + | 1583 -> One (r802) + | 1590 -> One (r803) + | 1587 -> One (r805) + | 1586 -> One (r806) + | 1595 -> One (r807) + | 1594 -> One (r808) + | 1599 -> One (r810) + | 1598 -> One (r811) + | 1593 -> One (r812) + | 1597 -> One (r813) + | 1607 -> One (r814) + | 1606 -> One (r815) + | 1603 -> One (r816) + | 1605 -> One (r817) + | 1609 -> One (r818) + | 1612 -> One (r819) + | 1611 -> One (r820) + | 1614 -> One (r821) + | 1629 -> One (r822) + | 1627 -> One (r823) + | 1636 -> One (r824) + | 1635 -> One (r825) + | 1634 -> One (r826) + | 1633 -> One (r827) + | 1640 -> One (r828) + | 1639 -> One (r829) + | 1638 -> One (r830) + | 1645 -> One (r831) + | 1644 -> One (r832) + | 1643 -> One (r833) + | 1651 -> One (r834) + | 1659 -> One (r835) + | 1664 -> One (r836) + | 1663 -> One (r837) + | 1662 -> One (r838) + | 1670 -> One (r839) + | 1669 -> One (r840) + | 1668 -> One (r841) + | 1675 -> One (r842) + | 1674 -> One (r843) + | 1673 -> One (r844) + | 1773 -> One (r845) + | 1679 -> One (r846) + | 1678 -> One (r847) + | 1727 -> One (r848) + | 1726 -> One (r849) + | 1725 -> One (r850) + | 1683 -> One (r851) + | 1682 -> One (r852) + | 1681 -> One (r853) + | 1687 -> One (r854) + | 1686 -> One (r855) + | 1685 -> One (r856) + | 1691 -> One (r857) + | 1690 -> One (r858) + | 1689 -> One (r859) + | 1695 -> One (r860) + | 1694 -> One (r861) + | 1693 -> One (r862) + | 1702 -> One (r863) + | 1701 -> One (r864) + | 1700 -> One (r865) + | 1699 -> One (r866) + | 1698 -> One (r867) + | 1706 -> One (r868) + | 1705 -> One (r869) + | 1704 -> One (r870) + | 1710 -> One (r871) + | 1709 -> One (r872) + | 1708 -> One (r873) + | 1724 -> One (r874) + | 1723 -> One (r875) + | 1719 -> One (r876) + | 1715 -> One (r877) + | 1714 -> One (r878) + | 1713 -> One (r879) + | 1718 -> One (r880) + | 1717 -> One (r881) + | 1722 -> One (r882) + | 1721 -> One (r883) + | 1746 -> One (r884) + | 1745 -> One (r885) + | 1744 -> One (r886) + | 1731 -> One (r887) + | 1730 -> One (r888) + | 1734 -> One (r889) + | 1733 -> One (r890) + | 1737 -> One (r891) + | 1736 -> One (r892) + | 1740 -> One (r893) + | 1739 -> One (r894) + | 1743 -> One (r895) + | 1742 -> One (r896) + | 1750 -> One (r897) + | 1749 -> One (r898) + | 1748 -> One (r899) + | 1753 -> One (r900) + | 1768 -> One (r901) + | 1767 -> One (r902) + | 1766 -> One (r903) + | 1765 -> One (r904) + | 1764 -> One (r905) + | 1760 -> One (r906) + | 1759 -> One (r907) + | 1758 -> One (r908) + | 1757 -> One (r909) + | 1762 -> One (r910) + | 1772 -> One (r911) + | 1776 -> One (r912) + | 2049 -> One (r913) + | 1780 -> One (r914) + | 1779 -> One (r915) + | 2036 -> One (r916) + | 1844 -> One (r917) + | 1843 -> One (r918) + | 1782 -> One (r919) + | 1828 -> One (r920) + | 1821 -> One (r921) + | 1818 -> One (r923) + | 1817 -> One (r924) + | 1798 -> One (r925) + | 1793 -> One (r926) + | 1789 -> One (r927) + | 1788 -> One (r928) + | 1785 -> One (r929) + | 1787 -> One (r930) + | 1792 -> One (r931) + | 1791 -> One (r932) + | 1797 -> One (r933) + | 1796 -> One (r934) + | 1795 -> One (r935) + | 1802 -> One (r936) + | 1801 -> One (r937) + | 1800 -> One (r938) + | 1804 -> One (r939) + | 1814 -> One (r940) + | 1810 -> One (r941) + | 1808 -> One (r942) + | 1807 -> One (r943) + | 1813 -> One (r944) + | 1812 -> One (r945) + | 1824 -> One (r946) + | 1827 -> One (r947) + | 1834 -> One (r948) + | 1831 -> One (r949) + | 1833 -> One (r950) + | 1839 -> One (r951) + | 1836 -> One (r952) + | 1838 -> One (r953) + | 1842 -> One (r954) + | 1841 -> One (r955) + | 1976 -> One (r956) + | 1975 -> One (r957) + | 1846 -> One (r958) + | 1848 -> One (r959) + | 1850 -> One (r960) + | 1854 -> One (r961) + | 1852 -> One (r962) + | 1867 -> One (r963) + | 1856 -> One (r964) + | 1860 -> One (r965) + | 1865 -> One (r966) + | 1869 -> One (r967) + | 1883 -> One (r968) + | 1879 -> One (r969) + | 1876 -> One (r971) + | 1881 -> One (r972) + | 1895 -> One (r973) + | 1889 -> One (r974) + | 1886 -> One (r975) + | 1888 -> One (r976) + | 1892 -> One (r977) + | 1891 -> One (r978) + | 1894 -> One (r979) + | 1907 -> One (r980) + | 1905 -> One (r982) + | 1902 -> One (r983) + | 1901 -> One (r984) + | 1904 -> One (r985) + | 1909 -> One (r986) + | 1912 -> One (r987) + | 1914 -> One (r988) + | 1928 -> One (r989) + | 1927 -> One (r990) + | 1926 -> One (r991) + | 1916 -> One (r992) + | 1924 -> One (r993) + | 1920 -> One (r994) + | 1919 -> One (r995) + | 1918 -> One (r996) + | 1922 -> One (r997) + | 1941 -> One (r998) + | 1931 -> One (r999) + | 1930 -> One (r1000) + | 1933 -> One (r1001) + | 1935 -> One (r1002) + | 1940 -> One (r1003) + | 1937 -> One (r1004) + | 1939 -> One (r1005) + | 1943 -> One (r1006) + | 1949 -> One (r1007) + | 1950 -> One (r1009) + | 1946 -> One (r1010) + | 1948 -> One (r1011) + | 1953 -> One (r1012) + | 1959 -> One (r1013) + | 1960 -> One (r1015) + | 1965 -> One (r1016) + | 1964 -> One (r1017) + | 1968 -> One (r1018) + | 1967 -> One (r1019) + | 2005 -> One (r1020) + | 1997 -> One (r1021) + | 1991 -> One (r1022) + | 1990 -> One (r1023) + | 1995 -> One (r1024) + | 1994 -> One (r1025) + | 1993 -> One (r1026) + | 1999 -> One (r1027) + | 2004 -> One (r1028) + | 2002 -> One (r1030) + | 2001 -> One (r1031) + | 2011 -> One (r1032) + | 2008 -> One (r1033) + | 2010 -> One (r1034) + | 2013 -> One (r1035) + | 2019 -> One (r1036) + | 2029 -> One (r1037) + | 2024 -> One (r1038) + | 2026 -> One (r1039) + | 2028 -> One (r1040) + | 2040 -> One (r1041) + | 2044 -> One (r1042) + | 2051 -> One (r1043) + | 2150 -> One (r1044) + | 2056 -> One (r1045) + | 2055 -> One (r1046) + | 2147 -> One (r1047) + | 2146 -> One (r1048) + | 2058 -> One (r1049) + | 2061 -> One (r1050) + | 2060 -> One (r1051) + | 2063 -> One (r1052) + | 2066 -> One (r1053) + | 2072 -> One (r1054) + | 2071 -> One (r1055) + | 2087 -> One (r1056) + | 2090 -> One (r1058) + | 2083 -> One (r1060) + | 2077 -> One (r1061) + | 2076 -> One (r1062) + | 2086 -> One (r1063) + | 2094 -> One (r1064) + | 2097 -> One (r1065) + | 2096 -> One (r1066) + | 2100 -> One (r1067) + | 2107 -> One (r1069) + | 2105 -> One (r1070) + | 2103 -> One (r1071) + | 2111 -> One (r1072) + | 2110 -> One (r1073) + | 2109 -> One (r1074) + | 2115 -> One (r1075) + | 2114 -> One (r1076) + | 2113 -> One (r1077) + | 2123 -> One (r1078) + | 2122 -> One (r1079) + | 2140 -> One (r1080) + | 2153 -> One (r1081) + | 3807 -> One (r1082) + | 3806 -> One (r1083) + | 3805 -> One (r1084) + | 3804 -> One (r1085) + | 2171 -> One (r1086) + | 3796 -> One (r1087) + | 3787 -> One (r1088) + | 2200 -> One (r1089) + | 2192 -> One (r1090) + | 2189 -> One (r1091) + | 2174 -> One (r1092) + | 2186 -> One (r1093) + | 2182 -> One (r1095) + | 2181 -> One (r1096) + | 2180 -> One (r1097) + | 2178 -> One (r1099) + | 2184 -> One (r1100) + | 2191 -> One (r1101) + | 2190 -> One (r1102) + | 2196 -> One (r1103) + | 2195 -> One (r1104) + | 2198 -> One (r1105) + | 2209 -> One (r1106) + | 2208 -> One (r1107) + | 2207 -> One (r1108) + | 2206 -> One (r1109) + | 2202 -> One (r1110) + | 2205 | 2713 -> One (r1111) + | 3781 -> One (r1112) + | 2344 -> One (r1113) + | 2343 -> One (r1114) + | 2291 -> One (r1115) + | 2290 -> One (r1116) + | 2214 -> One (r1117) + | 2340 -> One (r1119) + | 2213 -> One (r1120) + | 2212 -> One (r1121) + | 2226 -> One (r1122) + | 2225 -> One (r1124) + | 2219 -> One (r1125) + | 2218 -> One (r1126) + | 2216 -> One (r1127) + | 2230 -> One (r1128) + | 2229 -> One (r1129) + | 2228 -> One (r1130) + | 2236 -> One (r1131) + | 2235 -> One (r1132) + | 2234 -> One (r1133) + | 2233 -> One (r1134) + | 2240 -> One (r1135) + | 2239 -> One (r1136) + | 2238 -> One (r1137) + | 2244 -> One (r1138) + | 2243 -> One (r1139) + | 2242 -> One (r1140) + | 2248 -> One (r1141) + | 2247 -> One (r1142) + | 2246 -> One (r1143) + | 2262 -> One (r1144) + | 2261 -> One (r1145) + | 2260 -> One (r1146) + | 2259 -> One (r1147) + | 2254 -> One (r1148) + | 2253 -> One (r1149) + | 2252 -> One (r1150) + | 2251 -> One (r1151) + | 2258 -> One (r1152) + | 2257 -> One (r1153) + | 2256 -> One (r1154) + | 2266 -> One (r1155) + | 2265 -> One (r1156) + | 2264 -> One (r1157) + | 2279 -> One (r1158) + | 2270 -> One (r1159) + | 2269 -> One (r1160) + | 2277 -> One (r1161) + | 2276 -> One (r1162) + | 2275 -> One (r1163) + | 2283 -> One (r1164) + | 2282 -> One (r1165) + | 2287 -> One (r1166) + | 2286 -> One (r1167) + | 2285 -> One (r1168) + | 2289 -> One (r1169) + | 2317 -> One (r1170) + | 2316 -> One (r1171) + | 2297 -> One (r1172) + | 2296 -> One (r1173) + | 2295 -> One (r1174) + | 2294 -> One (r1175) + | 2301 -> One (r1176) + | 2300 -> One (r1177) + | 2299 -> One (r1178) + | 2306 -> One (r1179) + | 2305 -> One (r1180) + | 2304 -> One (r1181) + | 2309 -> One (r1182) + | 2308 -> One (r1183) + | 2313 -> One (r1184) + | 2312 -> One (r1185) + | 2311 -> One (r1186) + | 2315 -> One (r1187) + | 2326 -> One (r1188) + | 2320 -> One (r1189) + | 2319 -> One (r1190) + | 2323 -> One (r1191) + | 2325 -> One (r1192) + | 2331 | 3478 -> One (r1193) + | 2332 -> One (r1195) + | 2335 -> One (r1197) + | 2339 -> One (r1198) + | 2338 -> One (r1199) + | 2337 -> One (r1200) + | 3544 -> One (r1201) + | 2370 -> One (r1203) + | 2362 -> One (r1204) + | 2354 -> One (r1205) + | 2351 -> One (r1206) + | 2348 -> One (r1207) + | 2347 -> One (r1208) + | 2350 -> One (r1209) + | 2353 -> One (r1210) + | 2356 -> One (r1211) + | 2359 -> One (r1212) + | 2358 -> One (r1213) + | 2361 -> One (r1214) + | 2366 -> One (r1215) + | 2365 -> One (r1216) + | 2368 -> One (r1217) + | 3751 -> One (r1218) + | 2373 -> One (r1219) + | 2403 -> One (r1220) + | 2389 -> One (r1221) + | 2388 -> One (r1222) + | 2375 -> One (r1223) + | 2386 -> One (r1224) + | 2387 -> One (r1226) + | 2381 -> One (r1227) + | 2379 -> One (r1228) + | 2377 -> One (r1229) + | 2385 -> One (r1230) + | 2384 -> One (r1231) + | 2383 -> One (r1232) + | 2400 -> One (r1233) + | 2396 -> One (r1234) + | 2395 -> One (r1235) + | 2394 -> One (r1236) + | 2399 -> One (r1237) + | 2398 -> One (r1238) + | 2406 -> One (r1239) + | 2405 -> One (r1240) + | 3709 -> One (r1241) + | 2414 -> One (r1242) + | 2411 -> One (r1243) + | 2430 -> One (r1244) + | 2427 -> One (r1246) + | 2426 -> One (r1248) + | 2421 -> One (r1249) + | 2420 -> One (r1250) + | 2418 -> One (r1251) + | 2417 -> One (r1252) + | 2416 -> One (r1253) + | 2424 -> One (r1254) + | 2423 -> One (r1255) + | 2432 -> One (r1256) + | 2435 -> One (r1257) + | 3696 -> One (r1258) + | 3687 -> One (r1259) + | 3686 -> One (r1260) + | 3685 -> One (r1261) + | 2773 -> One (r1262) + | 2772 -> One (r1263) + | 3684 -> One (r1265) + | 2441 -> One (r1266) + | 2440 -> One (r1267) + | 2439 -> One (r1268) + | 3678 -> One (r1269) + | 3676 -> One (r1270) + | 3674 -> One (r1271) + | 3668 -> One (r1272) + | 2444 -> One (r1274) + | 2447 -> One (r1276) + | 2446 -> One (r1277) + | 2445 -> One (r1278) + | 3643 -> One (r1279) + | 2460 -> One (r1280) + | 2458 -> One (r1281) + | 2453 -> One (r1282) + | 2456 -> One (r1284) + | 2455 -> One (r1285) + | 2454 -> One (r1286) + | 2462 -> One (r1287) + | 3590 -> One (r1288) + | 2466 -> One (r1289) + | 2465 -> One (r1290) + | 2468 -> One (r1291) + | 2470 -> One (r1292) + | 2477 -> One (r1293) + | 2479 -> One (r1295) + | 2474 -> One (r1296) + | 2473 -> One (r1297) + | 2472 -> One (r1298) + | 2476 -> One (r1299) + | 2488 -> One (r1300) + | 2487 -> One (r1301) + | 2489 -> One (r1303) + | 2486 -> One (r1304) + | 2485 -> One (r1305) + | 2484 -> One (r1306) + | 2483 -> One (r1307) + | 2496 -> One (r1308) + | 2495 -> One (r1309) + | 2493 -> One (r1310) + | 2492 -> One (r1311) + | 2498 -> One (r1312) + | 2501 -> One (r1313) + | 2500 -> One (r1314) + | 2507 -> One (r1315) + | 2506 -> One (r1316) + | 2505 -> One (r1317) + | 2504 -> One (r1318) + | 2514 -> One (r1319) + | 2513 -> One (r1320) + | 2512 -> One (r1321) + | 2511 -> One (r1322) + | 2510 -> One (r1323) + | 2573 -> One (r1324) + | 2520 -> One (r1325) + | 2533 -> One (r1327) + | 2532 -> One (r1329) + | 2529 -> One (r1330) + | 2528 -> One (r1331) + | 2538 -> One (r1332) + | 2537 -> One (r1333) + | 2536 -> One (r1334) + | 2548 -> One (r1335) + | 2553 -> One (r1337) + | 2551 -> One (r1338) + | 2542 -> One (r1339) + | 2541 -> One (r1340) + | 2540 -> One (r1341) + | 2545 -> One (r1342) + | 2550 -> One (r1343) + | 2560 -> One (r1344) + | 2561 -> One (r1346) + | 2558 -> One (r1347) + | 2557 -> One (r1348) + | 2565 -> One (r1349) + | 2564 -> One (r1350) + | 2571 -> One (r1351) + | 2572 -> One (r1353) + | 2569 -> One (r1354) + | 2568 -> One (r1355) + | 2576 -> One (r1356) + | 2575 -> One (r1357) + | 2589 -> One (r1358) + | 2578 -> One (r1359) + | 2591 -> One (r1361) + | 2587 -> One (r1362) + | 2596 -> One (r1363) + | 2595 -> One (r1364) + | 2598 -> One (r1366) + | 2597 -> One (r1367) + | 2594 -> One (r1368) + | 2607 -> One (r1369) + | 2606 -> One (r1371) + | 2600 -> One (r1372) + | 2603 -> One (r1373) + | 2604 -> One (r1375) + | 2613 -> One (r1376) + | 2611 -> One (r1377) + | 2618 -> One (r1378) + | 2617 -> One (r1379) + | 2616 -> One (r1380) + | 2623 -> One (r1381) + | 2628 -> One (r1383) + | 2625 -> One (r1384) + | 2624 -> One (r1385) + | 2627 -> One (r1386) + | 2633 -> One (r1387) + | 2632 -> One (r1388) + | 2637 -> One (r1389) + | 2642 -> One (r1390) + | 2641 -> One (r1391) + | 2640 -> One (r1392) + | 3551 -> One (r1393) + | 3560 -> One (r1395) + | 3559 -> One (r1396) + | 2648 -> One (r1397) + | 2647 -> One (r1398) + | 2646 -> One (r1399) + | 2645 -> One (r1400) + | 2644 -> One (r1401) + | 2655 -> One (r1402) + | 2654 -> One (r1403) + | 2653 -> One (r1404) + | 2652 -> One (r1405) + | 2650 -> One (r1406) + | 3536 -> One (r1407) + | 2664 -> One (r1408) + | 3530 -> One (r1410) + | 2665 -> One (r1411) + | 2662 -> One (r1412) + | 2659 -> One (r1413) + | 2658 -> One (r1414) + | 2661 -> One (r1415) + | 2669 -> One (r1416) + | 2668 -> One (r1417) + | 2667 -> One (r1418) + | 2673 -> One (r1419) + | 2672 -> One (r1420) + | 2678 -> One (r1421) + | 2681 -> One (r1423) + | 2680 -> One (r1424) + | 2679 -> One (r1425) + | 2676 -> One (r1426) + | 3520 -> One (r1427) + | 2703 -> One (r1428) + | 2699 -> One (r1429) + | 2698 -> One (r1430) + | 2692 -> One (r1431) + | 2689 -> One (r1432) + | 2688 -> One (r1433) + | 2685 -> One (r1434) + | 2691 -> One (r1435) + | 2694 -> One (r1436) + | 2697 -> One (r1437) + | 2696 -> One (r1438) + | 2702 -> One (r1439) + | 2701 -> One (r1440) + | 3493 -> One (r1441) + | 2708 -> One (r1442) + | 2707 -> One (r1443) + | 2710 -> One (r1444) + | 3482 -> One (r1445) + | 3479 -> One (r1446) + | 2737 -> One (r1447) + | 2736 -> One (r1448) + | 2728 | 3303 -> One (r1449) + | 2733 -> One (r1451) + | 2732 -> One (r1452) + | 2731 -> One (r1453) + | 2725 -> One (r1454) + | 2722 -> One (r1455) + | 2721 -> One (r1456) + | 2735 -> One (r1458) + | 2717 -> One (r1459) + | 2720 -> One (r1460) + | 2719 -> One (r1461) + | 2727 -> One (r1462) + | 3477 -> One (r1463) + | 3476 -> One (r1464) + | 2740 -> One (r1465) + | 2749 -> One (r1466) + | 2748 -> One (r1467) + | 2747 -> One (r1468) + | 2745 -> One (r1469) + | 2744 -> One (r1470) + | 2758 -> One (r1471) + | 2754 -> One (r1472) + | 2753 -> One (r1473) + | 2757 -> One (r1474) + | 3463 -> One (r1475) + | 2774 -> One (r1476) + | 2769 -> One (r1477) + | 2768 -> One (r1478) + | 3457 -> One (r1479) + | 3455 -> One (r1480) + | 2783 -> One (r1481) + | 2782 -> One (r1482) + | 2781 -> One (r1483) + | 2780 -> One (r1484) + | 2779 -> One (r1485) + | 2778 -> One (r1486) + | 2790 -> One (r1487) + | 2789 -> One (r1488) + | 2788 -> One (r1489) + | 2787 -> One (r1490) + | 2786 -> One (r1491) + | 2785 -> One (r1492) + | 2812 -> One (r1493) + | 2809 -> One (r1495) + | 2808 -> One (r1496) + | 2794 -> One (r1497) + | 2792 -> One (r1498) + | 2806 -> One (r1499) + | 2798 -> One (r1500) + | 2802 -> One (r1501) + | 2868 -> One (r1502) + | 2867 -> One (r1503) + | 2874 -> One (r1505) + | 2814 -> One (r1506) + | 2817 -> One (r1507) + | 2846 -> One (r1508) + | 2820 -> One (r1509) + | 2832 -> One (r1510) + | 2824 -> One (r1511) + | 2823 -> One (r1512) + | 2828 -> One (r1513) + | 2827 -> One (r1514) + | 2831 -> One (r1515) + | 2830 -> One (r1516) + | 2835 -> One (r1517) + | 2839 -> One (r1518) + | 2843 -> One (r1519) + | 2842 -> One (r1520) + | 2841 -> One (r1521) + | 2845 -> One (r1522) + | 2865 -> One (r1523) + | 2852 -> One (r1524) + | 2855 -> One (r1525) + | 2854 -> One (r1526) + | 2857 -> One (r1528) + | 2856 -> One (r1530) + | 2860 -> One (r1531) + | 2862 -> One (r1532) + | 2873 -> One (r1533) + | 2872 -> One (r1534) + | 2871 -> One (r1535) + | 2870 -> One (r1536) + | 2876 -> One (r1537) + | 2878 -> One (r1538) + | 2880 -> One (r1539) + | 2896 -> One (r1540) + | 2895 -> One (r1541) + | 2900 -> One (r1542) + | 2899 -> One (r1543) + | 2910 -> One (r1544) + | 2909 -> One (r1545) + | 2903 -> One (r1546) + | 2907 -> One (r1547) + | 2906 -> One (r1548) + | 2905 -> One (r1549) + | 2913 -> One (r1550) + | 2912 -> One (r1551) + | 2918 -> One (r1552) + | 2917 -> One (r1553) + | 2921 -> One (r1554) + | 2920 -> One (r1555) + | 2926 -> One (r1556) + | 2925 -> One (r1557) + | 2929 -> One (r1558) + | 2928 -> One (r1559) + | 2934 -> One (r1560) + | 2933 -> One (r1561) + | 2937 -> One (r1562) + | 2936 -> One (r1563) + | 2941 -> One (r1564) + | 2940 -> One (r1565) + | 2944 -> One (r1566) + | 2943 -> One (r1567) + | 2949 -> One (r1568) + | 2948 -> One (r1569) + | 2952 -> One (r1570) + | 2951 -> One (r1571) + | 3451 -> One (r1572) + | 3453 -> One (r1574) + | 2955 -> One (r1575) + | 2954 -> One (r1576) + | 2957 -> One (r1577) + | 3449 -> One (r1578) + | 2960 -> One (r1579) + | 2968 -> One (r1580) + | 2967 -> One (r1581) + | 2966 -> One (r1582) + | 2972 -> One (r1583) + | 2976 -> One (r1584) + | 2975 -> One (r1585) + | 2974 -> One (r1586) + | 2982 -> One (r1587) + | 2984 -> One (r1588) + | 2997 -> One (r1589) + | 2988 -> One (r1590) + | 2991 -> One (r1591) + | 2994 -> One (r1592) + | 2996 -> One (r1593) + | 3000 -> One (r1594) + | 3445 -> One (r1596) + | 3436 -> One (r1598) + | 3036 -> One (r1599) + | 3035 -> One (r1601) + | 3442 -> One (r1603) + | 3437 -> One (r1604) + | 3001 -> One (r1605) + | 3015 -> One (r1606) + | 3017 -> One (r1608) + | 3016 -> One (r1610) + | 3008 -> One (r1611) + | 3007 -> One (r1612) + | 3006 -> One (r1613) + | 3005 -> One (r1614) + | 3011 -> One (r1615) + | 3010 -> One (r1616) + | 3019 -> One (r1617) + | 3021 -> One (r1618) + | 3027 -> One (r1619) + | 3026 -> One (r1620) + | 3025 -> One (r1621) + | 3032 -> One (r1622) + | 3040 -> One (r1623) + | 3039 -> One (r1624) + | 3038 -> One (r1625) + | 3042 -> One (r1626) + | 3049 -> One (r1628) + | 3048 -> One (r1629) + | 3057 -> One (r1631) + | 3044 -> One (r1632) + | 3047 -> One (r1633) + | 3056 -> One (r1634) + | 3055 -> One (r1636) + | 3052 -> One (r1637) + | 3405 -> One (r1638) + | 3061 -> One (r1639) + | 3060 -> One (r1640) + | 3059 -> One (r1641) + | 3399 -> One (r1642) + | 3397 -> One (r1643) + | 3396 -> One (r1644) + | 3368 -> One (r1645) + | 3351 -> One (r1646) + | 3349 -> One (r1647) + | 3066 -> One (r1648) + | 3068 -> One (r1649) + | 3072 -> One (r1650) + | 3071 -> One (r1651) + | 3070 -> One (r1652) + | 3337 -> One (r1653) + | 3078 -> One (r1654) + | 3077 -> One (r1655) + | 3076 -> One (r1656) + | 3329 -> One (r1657) + | 3081 -> One (r1658) + | 3089 -> One (r1659) + | 3086 -> One (r1660) + | 3085 -> One (r1661) + | 3088 -> One (r1662) + | 3095 -> One (r1663) + | 3094 -> One (r1664) + | 3098 -> One (r1665) + | 3103 -> One (r1666) + | 3111 -> One (r1668) + | 3110 -> One (r1669) + | 3109 -> One (r1670) + | 3108 -> One (r1671) + | 3107 -> One (r1673) + | 3318 -> One (r1674) + | 3121 -> One (r1675) + | 3120 -> One (r1676) + | 3119 -> One (r1677) + | 3118 -> One (r1678) + | 3115 -> One (r1679) + | 3117 -> One (r1680) + | 3125 -> One (r1681) + | 3124 -> One (r1682) + | 3123 -> One (r1683) + | 3129 -> One (r1685) + | 3128 -> One (r1686) + | 3127 -> One (r1687) + | 3289 -> One (r1688) + | 3280 -> One (r1689) + | 3279 -> One (r1690) + | 3278 -> One (r1691) + | 3277 -> One (r1692) + | 3134 -> One (r1693) + | 3133 -> One (r1694) + | 3132 -> One (r1695) + | 3269 -> One (r1696) + | 3265 -> One (r1697) + | 3264 -> One (r1698) + | 3239 -> One (r1699) + | 3233 -> One (r1700) + | 3232 -> One (r1701) + | 3231 -> One (r1702) + | 3203 -> One (r1703) + | 3198 -> One (r1704) + | 3202 -> One (r1705) + | 3214 -> One (r1706) + | 3213 -> One (r1707) + | 3212 -> One (r1708) + | 3229 -> One (r1710) + | 3226 -> One (r1712) + | 3215 -> One (r1713) + | 3208 -> One (r1714) + | 3207 -> One (r1715) + | 3211 -> One (r1716) + | 3210 -> One (r1717) + | 3218 -> One (r1718) + | 3217 -> One (r1719) + | 3223 -> One (r1720) + | 3220 -> One (r1721) + | 3222 -> One (r1722) + | 3225 -> One (r1723) + | 3236 -> One (r1724) + | 3235 -> One (r1725) + | 3238 -> One (r1726) + | 3261 -> One (r1727) + | 3260 -> One (r1728) + | 3252 -> One (r1729) + | 3243 -> One (r1730) + | 3246 -> One (r1731) + | 3245 -> One (r1732) + | 3249 -> One (r1733) + | 3248 -> One (r1734) + | 3251 -> One (r1735) + | 3256 -> One (r1736) + | 3259 -> One (r1737) + | 3263 -> One (r1738) + | 3267 -> One (r1739) + | 3274 -> One (r1740) + | 3271 -> One (r1741) + | 3273 -> One (r1742) + | 3276 -> One (r1743) + | 3283 -> One (r1744) + | 3282 -> One (r1745) + | 3286 -> One (r1746) + | 3285 -> One (r1747) + | 3288 -> One (r1748) + | 3302 -> One (r1749) + | 3293 -> One (r1750) + | 3292 -> One (r1751) + | 3296 -> One (r1752) + | 3295 -> One (r1753) + | 3299 -> One (r1754) + | 3298 -> One (r1755) + | 3301 -> One (r1756) + | 3314 -> One (r1757) + | 3305 -> One (r1758) + | 3308 -> One (r1759) + | 3307 -> One (r1760) + | 3311 -> One (r1761) + | 3310 -> One (r1762) + | 3313 -> One (r1763) + | 3322 -> One (r1764) + | 3325 -> One (r1765) + | 3332 -> One (r1766) + | 3339 -> One (r1767) + | 3342 -> One (r1768) + | 3344 -> One (r1769) + | 3362 -> One (r1770) + | 3353 -> One (r1771) + | 3356 -> One (r1772) + | 3355 -> One (r1773) + | 3359 -> One (r1774) + | 3358 -> One (r1775) + | 3361 -> One (r1776) + | 3365 -> One (r1777) + | 3364 -> One (r1778) + | 3367 -> One (r1779) + | 3371 -> One (r1780) + | 3370 -> One (r1781) + | 3377 -> One (r1782) + | 3379 -> One (r1783) + | 3381 -> One (r1784) + | 3385 -> One (r1785) + | 3384 -> One (r1786) + | 3391 -> One (r1787) + | 3388 -> One (r1788) + | 3390 -> One (r1789) + | 3402 -> One (r1790) + | 3401 -> One (r1791) + | 3404 -> One (r1792) + | 3420 -> One (r1793) + | 3411 -> One (r1794) + | 3408 -> One (r1795) + | 3407 -> One (r1796) + | 3410 -> One (r1797) + | 3414 -> One (r1798) + | 3413 -> One (r1799) + | 3417 -> One (r1800) + | 3416 -> One (r1801) + | 3419 -> One (r1802) + | 3435 -> One (r1803) + | 3426 -> One (r1804) + | 3425 -> One (r1805) + | 3424 -> One (r1806) + | 3423 -> One (r1807) + | 3429 -> One (r1808) + | 3428 -> One (r1809) + | 3432 -> One (r1810) + | 3431 -> One (r1811) + | 3434 -> One (r1812) + | 3440 -> One (r1813) + | 3439 -> One (r1814) + | 3447 -> One (r1815) + | 3460 -> One (r1816) + | 3459 -> One (r1817) + | 3462 -> One (r1818) + | 3475 -> One (r1819) + | 3466 -> One (r1820) + | 3465 -> One (r1821) + | 3469 -> One (r1822) + | 3468 -> One (r1823) + | 3472 -> One (r1824) + | 3471 -> One (r1825) + | 3474 -> One (r1826) + | 3481 -> One (r1827) + | 3487 -> One (r1829) + | 3486 -> One (r1830) + | 3489 -> One (r1831) + | 3496 -> One (r1832) + | 3499 -> One (r1833) + | 3501 -> One (r1834) + | 3509 -> One (r1835) + | 3511 -> One (r1836) + | 3524 -> One (r1837) + | 3528 -> One (r1838) + | 3532 -> One (r1839) + | 3539 -> One (r1840) + | 3548 -> One (r1841) + | 3546 -> One (r1842) + | 3550 -> One (r1843) + | 3555 -> One (r1844) + | 3554 -> One (r1845) + | 3553 -> One (r1846) + | 3558 -> One (r1847) + | 3557 -> One (r1848) + | 3571 -> One (r1849) + | 3570 -> One (r1850) + | 3566 -> One (r1851) + | 3565 -> One (r1852) + | 3564 -> One (r1853) + | 3563 -> One (r1854) + | 3569 -> One (r1855) + | 3568 -> One (r1856) + | 3580 -> One (r1857) + | 3577 -> One (r1858) + | 3576 -> One (r1859) + | 3581 -> One (r1861) + | 3584 -> One (r1863) + | 3582 -> One (r1864) + | 3575 -> One (r1865) + | 3574 -> One (r1866) + | 3579 -> One (r1867) + | 3588 -> One (r1868) + | 3587 -> One (r1869) + | 3586 -> One (r1870) + | 3594 -> One (r1871) + | 3597 -> One (r1872) + | 3605 -> One (r1873) + | 3604 -> One (r1874) + | 3607 -> One (r1875) + | 3610 -> One (r1876) + | 3615 -> One (r1877) + | 3614 -> One (r1878) + | 3617 -> One (r1879) + | 3620 -> One (r1880) + | 3628 -> One (r1881) + | 3632 -> One (r1882) + | 3635 -> One (r1883) + | 3646 -> One (r1884) + | 3650 -> One (r1885) + | 3649 -> One (r1886) + | 3652 -> One (r1887) + | 3656 -> One (r1888) + | 3658 -> One (r1889) + | 3663 -> One (r1890) + | 3671 -> One (r1891) + | 3670 -> One (r1892) + | 3681 -> One (r1893) + | 3680 -> One (r1894) + | 3683 -> One (r1895) + | 3690 -> One (r1896) + | 3689 -> One (r1897) + | 3693 -> One (r1898) + | 3692 -> One (r1899) + | 3695 -> One (r1900) + | 3708 -> One (r1901) + | 3699 -> One (r1902) + | 3698 -> One (r1903) + | 3702 -> One (r1904) + | 3701 -> One (r1905) + | 3705 -> One (r1906) + | 3704 -> One (r1907) + | 3707 -> One (r1908) + | 3713 -> One (r1909) + | 3718 -> One (r1910) + | 3723 -> One (r1911) + | 3722 -> One (r1912) + | 3726 -> One (r1913) + | 3725 -> One (r1914) + | 3728 -> One (r1915) + | 3732 -> One (r1916) + | 3737 -> One (r1917) + | 3741 -> One (r1918) + | 3746 -> One (r1919) + | 3754 -> One (r1920) + | 3760 -> One (r1921) + | 3762 -> One (r1922) + | 3770 -> One (r1923) + | 3772 -> One (r1924) + | 3778 -> One (r1925) + | 3776 -> One (r1926) + | 3780 -> One (r1927) + | 3795 -> One (r1928) + | 3794 -> One (r1929) + | 3793 -> One (r1930) + | 3792 -> One (r1931) + | 3791 -> One (r1932) + | 3802 -> One (r1933) + | 3801 -> One (r1934) + | 3800 -> One (r1935) + | 3811 -> One (r1936) + | 3810 -> One (r1937) + | 3809 -> One (r1938) + | 3828 -> One (r1939) + | 3854 -> One (r1940) + | 3853 -> One (r1941) + | 3852 -> One (r1942) + | 3851 -> One (r1943) + | 3850 -> One (r1944) + | 3849 -> One (r1945) + | 3848 -> One (r1946) + | 3867 -> One (r1947) + | 3863 -> One (r1948) + | 3862 -> One (r1949) + | 3883 -> One (r1951) + | 3882 -> One (r1952) + | 3881 -> One (r1953) + | 3880 -> One (r1954) + | 3879 -> One (r1955) + | 3878 -> One (r1956) + | 3877 -> One (r1957) + | 3876 -> One (r1958) + | 3861 -> One (r1959) + | 3857 -> One (r1960) + | 3856 -> One (r1961) + | 3860 -> One (r1962) + | 3859 -> One (r1963) + | 3866 -> One (r1964) + | 3865 -> One (r1965) + | 3875 -> One (r1966) + | 3874 -> One (r1967) + | 3873 -> One (r1968) + | 3872 -> One (r1969) + | 3871 -> One (r1970) + | 3870 -> One (r1971) + | 3869 -> One (r1972) + | 3868 -> One (r1973) + | 3891 -> One (r1974) + | 3890 -> One (r1975) + | 3889 -> One (r1976) + | 3888 -> One (r1977) + | 3887 -> One (r1978) + | 3963 -> One (r1980) + | 3962 -> One (r1981) + | 3961 -> One (r1982) + | 3960 -> One (r1983) + | 3959 -> One (r1984) + | 3897 -> One (r1985) + | 3905 -> One (r1986) + | 3904 -> One (r1987) + | 3903 | 3976 -> One (r1988) + | 3902 | 3975 -> One (r1989) + | 3901 | 3974 -> One (r1990) + | 3900 | 3973 -> One (r1991) + | 3922 -> One (r1993) + | 3920 -> One (r1994) + | 3918 -> One (r1995) + | 3916 -> One (r1996) + | 3914 -> One (r1997) + | 3956 -> One (r1999) + | 3926 -> One (r2000) + | 3925 -> One (r2001) + | 3924 -> One (r2002) + | 3923 -> One (r2003) + | 3912 -> One (r2004) + | 3899 | 3972 -> One (r2005) + | 3909 -> One (r2006) + | 3911 -> One (r2008) + | 3910 -> One (r2009) + | 3906 | 3977 -> One (r2010) + | 3951 -> One (r2011) + | 3950 -> One (r2012) + | 3949 -> One (r2013) + | 3948 -> One (r2014) + | 3928 -> One (r2015) + | 3936 -> One (r2016) + | 3933 -> One (r2017) + | 3932 -> One (r2018) + | 3931 -> One (r2019) + | 3930 -> One (r2020) + | 3940 -> One (r2021) + | 3947 -> One (r2022) + | 3946 -> One (r2023) + | 3945 -> One (r2024) + | 3955 -> One (r2025) + | 3954 -> One (r2026) + | 3953 -> One (r2027) + | 3979 -> One (r2028) + | 3988 -> One (r2029) + | 3987 -> One (r2030) + | 3986 -> One (r2031) + | 3985 -> One (r2032) + | 3984 -> One (r2033) + | 3983 -> One (r2034) + | 3982 -> One (r2035) + | 3981 -> One (r2036) + | 3996 -> One (r2037) + | 1229 -> Select (function + | 1195 | 1324 | 1326 | 1330 | 1337 | 1339 -> S (T T_GT) :: r650 + | _ -> R 128 :: r649) + | 862 -> Select (function + | 2711 -> [R 671] + | _ -> S (T T_SUPER) :: r485) + | 986 -> Select (function + | -1 -> S (T T_COLON) :: r539 + | _ -> [R 2186]) + | 1192 -> Select (function + | 3002 | 3018 | 3438 -> r466 + | _ -> Sub (r621) :: r628) + | 1193 -> Select (function + | -1 -> r466 + | _ -> Sub (r621) :: r630) + | 1202 -> Select (function + | -1 -> r465 + | _ -> r618) + | _ -> raise Not_found diff --git a/src/lsp/cobol_parser/grammar_recover.mli b/src/lsp/cobol_parser/grammar_recover.mli new file mode 100644 index 000000000..5c0cdfa50 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_recover.mli @@ -0,0 +1,31 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Grammar +open MenhirInterpreter + +type action = + | Abort + | R of int + | S : 'a symbol -> action + | Sub of action list + +type decision = + | Nothing + | One of action list + | Select of (int -> action list) + +val can_pop : 'a Grammar.MenhirInterpreter.terminal -> bool +val depth : int array +val recover : int -> decision +val default_value : 'a Grammar.MenhirInterpreter.symbol -> 'a diff --git a/src/lsp/cobol_parser/grammar_tokens.mly b/src/lsp/cobol_parser/grammar_tokens.mly new file mode 100644 index 000000000..4d7e56330 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_tokens.mly @@ -0,0 +1,1156 @@ +%{ +(**************************************************************************) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) +%} + +%[@recovery.header + let fixed_zero = Cobol_ast.{ fixed_integer = "0"; + fixed_fractional = "0" } + + let floating_zero = Cobol_ast.{ float_significand = fixed_zero; + float_exponent = "1" } + + let boolean_zero = Cobol_ast.{ bool_base = `Bool; + bool_value = "0" } +] + +%token EOF +%token UNUSED__ + +%token WORD [@recovery "_"] (* [@symbol ""] *) +%token WORD_IN_AREA_A [@recovery "_"] (* [@symbol ""] *) +%token ALPHANUM [@recovery ("_", Quote)] +%token ALPHANUM_PREFIX [@recovery ("_", Quote)] +%token BOOLIT [@recovery boolean_zero] +%token HEXLIT [@recovery "_"] +%token NULLIT [@recovery "_"] +%token NATLIT [@recovery "_"] +%token SINTLIT [@recovery "0"] +%token FIXEDLIT [@recovery "0", '.', "0"] +%token FLOATLIT [@recovery "0", '.', "0", "1"] +%token DIGITS [@recovery "0"] (* keep as string until resolved as level/intlit *) +%token PICTURE_STRING [@recovery "X"] (* picture character string *) +%token EIGHTY_EIGHT + +%token AMPERSAND "&" [@symbol "&"] +%token ASTERISK "*" [@symbol "*"] +%token COLON ":" [@symbol ":"] +%token DASH_SIGN "-" [@symbol "-"] +%token DOUBLE_ASTERISK "**" [@symbol "**"] +%token DOUBLE_COLON "::" [@symbol "::"] +%token EQ "=" [@symbol "="] +%token GE ">=" [@symbol ">="] +%token GT ">" [@symbol ">"] +%token LE "<=" [@symbol "<="] +%token LPAR "(" [@symbol "("] +%token LT "<" [@symbol "<"] +%token NE "<>" [@symbol "<>"] +%token PERIOD "." [@symbol "."] +%token PLUS_SIGN "+" [@symbol "+"] +%token RPAR ")" [@symbol ")"] +%token SLASH "/" [@symbol "/"] + +(* Default reservable keywords *) + +%token ABSENT [@keyword] +%token ACCEPT [@keyword] +%token ACCESS [@keyword] +%token ACTION [@keyword] [@contexts ] +%token ACTIVATING [@keyword] [@contexts ] +%token ACTIVE_CLASS [@keyword] +%token ACTIVE_X [@keyword] [@contexts ] +%token ACTUAL [@keyword] [@contexts ] +%token ADD [@keyword] +%token ADDRESS [@keyword] +%token ADJUSTABLE_COLUMNS [@keyword] [@contexts ] +%token ADVANCING [@keyword] +%token AFTER [@keyword] +%token ALIGNED [@keyword] +%token ALIGNMENT [@keyword] [@contexts ] +%token ALL [@keyword] +%token ALLOCATE [@keyword] +%token ALLOWING [@keyword] [@contexts ] +%token ALPHABET [@keyword] +%token ALPHABETIC [@keyword] +%token ALPHABETIC_LOWER [@keyword] +%token ALPHABETIC_UPPER [@keyword] +%token ALPHANUMERIC [@keyword] +%token ALPHANUMERIC_EDITED [@keyword] +%token ALSO [@keyword] +%token ALTER [@keyword] +%token ALTERNATE [@keyword] +%token AND [@keyword] +%token ANUM [@keyword] [@contexts ] +%token ANY [@keyword] +%token ANYCASE [@keyword] +%token APPLY [@keyword] [@contexts ] +%token ARE [@keyword] +%token AREA [@keyword] +%token AREAS [@keyword] +%token ARGUMENT_NUMBER [@keyword] +%token ARGUMENT_VALUE [@keyword] +%token ARITHMETIC [@keyword] [@contexts options_paragraph] +%token AS [@keyword] +%token ASCENDING [@keyword] +%token ASCII [@keyword] [@contexts ] +%token ASSIGN [@keyword] +%token AT [@keyword] +%token ATTRIBUTE [@keyword] [@contexts set_stmt] +%token ATTRIBUTES [@keyword] [@contexts ] +%token AUTO [@keyword] [@contexts screen_descr_entry] +%token AUTOMATIC [@keyword] [@contexts lock_mode_clause] +%token AUTO_DECIMAL [@keyword] [@contexts ] +%token AUTO_SPIN [@keyword] [@contexts ] +%token AWAY_FROM_ZERO [@keyword] [@contexts rounded_phrase] +%token BACKGROUND_COLOR [@keyword] [@contexts screen_descr_entry] +%token BACKGROUND_HIGH [@keyword] +%token BACKGROUND_LOW [@keyword] +%token BACKGROUND_STANDARD [@keyword] +%token BACKWARD [@keyword] [@contexts ] +%token BAR [@keyword] [@contexts ] +%token BASED [@keyword] +%token BEFORE [@keyword] +%token BELL [@keyword] [@contexts screen_descr_entry, set_attribute_stmt] +%token BINARY [@keyword] +%token BINARY_CHAR [@keyword] +%token BINARY_C_LONG [@keyword] +%token BINARY_DOUBLE [@keyword] +%token BINARY_ENCODING [@keyword] [@contexts usage_clause, set_attribute_stmt] +%token BINARY_LONG [@keyword] +%token BINARY_SEQUENTIAL [@keyword] +%token BINARY_SHORT [@keyword] +%token BIT [@keyword] +%token BITMAP [@keyword] [@contexts ] +%token BITMAP_END [@keyword] [@contexts ] +%token BITMAP_HANDLE [@keyword] [@contexts ] +%token BITMAP_NUMBER [@keyword] [@contexts ] +%token BITMAP_START [@keyword] [@contexts ] +%token BITMAP_TIMER [@keyword] [@contexts ] +%token BITMAP_TRAILING [@keyword] [@contexts ] +%token BITMAP_TRANSPARENT_COLOR [@keyword] [@contexts ] +%token BITMAP_WIDTH [@keyword] [@contexts ] +%token BLANK [@keyword] +%token BLINK [@keyword] [@contexts screen_descr_entry, set_attribute_stmt] +%token BLOCK [@keyword] +%token BOOLEAN [@keyword] +%token BOTTOM [@keyword] +%token BOX [@keyword] [@contexts ] +%token BOXED [@keyword] [@contexts ] +%token BULK_ADDITION [@keyword] [@contexts ] +%token BUSY [@keyword] [@contexts ] +%token BUTTONS [@keyword] [@contexts ] +%token BY [@keyword] +%token BYTE [@keyword] [@contexts ] +%token BYTES [@keyword] +%token BYTE_LENGTH [@keyword] [@contexts constant] +%token B_AND [@keyword] +%token B_NOT [@keyword] +%token B_OR [@keyword] +%token B_SHIFT_L [@keyword] +%token B_SHIFT_LC [@keyword] +%token B_SHIFT_R [@keyword] +%token B_SHIFT_RC [@keyword] +%token B_XOR [@keyword] +%token C [@keyword] [@contexts ] +%token CALENDAR_FONT [@keyword] [@contexts ] +%token CALL [@keyword] +%token CANCEL [@keyword] +%token CANCEL_BUTTON [@keyword] [@contexts ] +%token CAPACITY [@keyword] [@contexts occurs_clause] +%token CARD_PUNCH [@keyword] [@contexts ] +%token CARD_READER [@keyword] [@contexts ] +%token CASSETTE [@keyword] [@contexts ] +%token CCOL [@keyword] [@contexts ] +%token CD [@keyword] +%token CELL [@keyword] [@contexts ] +%token CELL_COLOR [@keyword] [@contexts ] +%token CELL_DATA [@keyword] [@contexts ] +%token CELL_FONT [@keyword] [@contexts ] +%token CELL_PROTECTION [@keyword] [@contexts ] +%token CENTER [@keyword] [@contexts column_clause] +%token CENTERED [@keyword] [@contexts ] +%token CENTERED_HEADINGS [@keyword] [@contexts ] +%token CENTURY_DATE [@keyword] [@contexts ] +%token CF [@keyword] +%token CH [@keyword] +%token CHAIN [@keyword] +%token CHAINING [@keyword] +%token CHANGED [@keyword] [@contexts ] +%token CHARACTER [@keyword] +%token CHARACTERS [@keyword] +%token CHECK_BOX [@keyword] [@contexts ] +%token CLASS [@keyword] +%token CLASSIFICATION [@keyword] [@contexts object_computer_paragraph] +%token CLASS_ID [@keyword] +%token CLEAR_SELECTION [@keyword] [@contexts ] +%token CLINE [@keyword] [@contexts ] +%token CLINES [@keyword] [@contexts ] +%token CLOCK_UNITS [@keyword] +%token CLOSE [@keyword] +%token COBOL [@keyword] [@contexts entry_convention_clause] +%token CODE [@keyword] +%token CODE_SET [@keyword] +%token COL [@keyword] +%token COLLATING [@keyword] +%token COLOR [@keyword] +%token COLORS [@keyword] [@contexts ] +%token COLUMN [@keyword] +%token COLUMNS [@keyword "COLUMNS", "COLS"] +%token COLUMN_COLOR [@keyword] [@contexts ] +%token COLUMN_DIVIDERS [@keyword] [@contexts ] +%token COLUMN_FONT [@keyword] [@contexts ] +%token COLUMN_HEADINGS [@keyword] [@contexts ] +%token COLUMN_PROTECTION [@keyword] [@contexts ] +%token COMBO_BOX [@keyword] [@contexts ] +%token COMMA [@keyword] +%token COMMAND_LINE [@keyword] +%token COMMIT [@keyword] +%token COMMON [@keyword] +%token COMMUNICATION [@keyword] +%token COMPUTE [@keyword] +%token COMP [@keyword "COMPUTATIONAL", "COMP"] +%token COMP_0 [@keyword "COMPUTATIONAL-0", "COMP-0"] +%token COMP_1 [@keyword "COMPUTATIONAL-1", "COMP-1"] +%token COMP_2 [@keyword "COMPUTATIONAL-2", "COMP-2"] +%token COMP_3 [@keyword "COMPUTATIONAL-3", "COMP-3"] +%token COMP_4 [@keyword "COMPUTATIONAL-4", "COMP-4"] +%token COMP_5 [@keyword "COMPUTATIONAL-5", "COMP-5"] +%token COMP_6 [@keyword "COMPUTATIONAL-6", "COMP-6"] +%token COMP_N [@keyword "COMPUTATIONAL-N", "COMP-N"] +%token COMP_X [@keyword "COMPUTATIONAL-X", "COMP-X"] +%token COMP_9 [@keyword] +%token COMP_10 [@keyword] +%token COMP_15 [@keyword] +%token CONDITION [@keyword] +%token CONFIGURATION [@keyword] +%token CONSTANT [@keyword] +%token CONTAINS [@keyword] +%token CONTENT [@keyword] +%token CONTINUE [@keyword] +%token CONTROL [@keyword] +%token CONTROLS [@keyword] +%token CONVERSION [@keyword] [@contexts ] +%token CONVERTING [@keyword] +%token COPY [@keyword] +%token COPY_SELECTION [@keyword] [@contexts ] +%token CORE_INDEX [@keyword] [@contexts ] +%token CORRESPONDING [@keyword "CORR", "CORRESPONDING"] +%token COUNT [@keyword] +%token CRT [@keyword] +%token CRT_UNDER [@keyword] +%token CSIZE [@keyword] [@contexts ] +%token CURRENCY [@keyword] +%token CURRENT [@keyword] [@contexts ] +%token CURSOR [@keyword] +%token CURSOR_COL [@keyword] [@contexts ] +%token CURSOR_COLOR [@keyword] [@contexts ] +%token CURSOR_FRAME_WIDTH [@keyword] [@contexts ] +%token CURSOR_ROW [@keyword] [@contexts ] +%token CURSOR_X [@keyword] [@contexts ] +%token CURSOR_Y [@keyword] [@contexts ] +%token CUSTOM_PRINT_TEMPLATE [@keyword] [@contexts ] +%token CYCLE [@keyword] [@contexts ] +%token CYL_INDEX [@keyword] [@contexts ] +%token CYL_OVERFLOW [@keyword] [@contexts ] +%token DASHED [@keyword] [@contexts ] +%token DATA [@keyword] +%token DATA_COLUMNS [@keyword] [@contexts ] +%token DATA_POINTER [@keyword] +%token DATA_TYPES [@keyword] [@contexts ] +%token DATE [@keyword] +%token DATE_ENTRY [@keyword] [@contexts ] +%token DAY [@keyword] +%token DAY_OF_WEEK [@keyword] +%token DEBUGGING [@keyword] +%token DECIMAL_ENCODING [@keyword] [@contexts usage_clause, float_decimal_clause] +%token DECIMAL_POINT [@keyword] +%token DECLARATIVES [@keyword] +%token DEFAULT [@keyword] +%token DEFAULT_BUTTON [@keyword] [@contexts ] +%token DEFAULT_FONT [@keyword] +%token DEFINITION [@keyword] +%token DELETE [@keyword] +%token DELIMITED [@keyword] +%token DELIMITER [@keyword] +%token DEPENDING [@keyword] +%token DESCENDING [@keyword] +%token DESTINATION [@keyword] +%token DESTROY [@keyword] +%token DETAIL [@keyword "DE", "DETAIL"] +%token DISABLE [@keyword] +%token DISC [@keyword] [@contexts ] +%token DISK [@keyword] [@contexts ] +%token DISP [@keyword] [@contexts ] +%token DISPLAY [@keyword] +%token DISPLAY_1 [@keyword] +%token DISPLAY_COLUMNS [@keyword] [@contexts ] +%token DISPLAY_FORMAT [@keyword] [@contexts ] +%token DIVIDE [@keyword] +%token DIVIDERS [@keyword] [@contexts ] +%token DIVIDER_COLOR [@keyword] [@contexts ] +%token DIVISION [@keyword] +%token DOTDASH [@keyword] [@contexts ] +%token DOTTED [@keyword] [@contexts ] +%token DOUBLE [@keyword] +%token DOWN [@keyword] +%token DRAG_COLOR [@keyword] [@contexts ] +%token DROP_DOWN [@keyword] [@contexts ] +%token DROP_LIST [@keyword] [@contexts ] +%token DUPLICATES [@keyword] +%token DYNAMIC [@keyword] +%token EBCDIC [@keyword] [@contexts ] +%token EC [@keyword] +%token ECHO [@keyword] +%token EDITING [@keyword] +%token EGI [@keyword] +%token ELEMENT [@keyword] [@contexts ] +%token ELSE [@keyword] +%token EMI [@keyword] +%token ENABLE [@keyword] +%token ENCODING [@keyword] [@contexts ] +%token ENCRYPTION [@keyword] [@contexts ] +%token END [@keyword] +%token END_ACCEPT [@keyword] +%token END_ADD [@keyword] +%token END_CALL [@keyword] +%token END_CHAIN [@keyword] +%token END_COLOR [@keyword] [@contexts ] +%token END_COMPUTE [@keyword] +%token END_DELETE [@keyword] +%token END_DISPLAY [@keyword] +%token END_DIVIDE [@keyword] +%token END_EVALUATE [@keyword] +%token END_IF [@keyword] +%token END_JSON [@keyword] +%token END_MODIFY [@keyword] [@contexts ] +%token END_MULTIPLY [@keyword] +%token END_OF_PAGE [@keyword] +%token END_PERFORM [@keyword] +%token END_READ [@keyword] +%token END_RECEIVE [@keyword] +%token END_RETURN [@keyword] +%token END_REWRITE [@keyword] +%token END_SEARCH [@keyword] +%token END_SEND [@keyword] +%token END_START [@keyword] +%token END_STRING [@keyword] +%token END_SUBTRACT [@keyword] +%token END_UNSTRING [@keyword] +%token END_WRITE [@keyword] +%token END_XML [@keyword] +%token ENGRAVED [@keyword] [@contexts ] +%token ENSURE_VISIBLE [@keyword] [@contexts ] +%token ENTER [@keyword] +%token ENTRY [@keyword] +%token ENTRY_CONVENTION [@keyword] [@contexts options_paragraph] +%token ENTRY_FIELD [@keyword] [@contexts ] +%token ENTRY_REASON [@keyword] [@contexts ] +%token ENVIRONMENT [@keyword] +%token ENVIRONMENT_NAME [@keyword] +%token ENVIRONMENT_VALUE [@keyword] +%token EO [@keyword] +%token EOL [@keyword] [@contexts erase_clause] +%token EOP [@keyword] +%token EOS [@keyword] [@contexts erase_clause] +%token EQUAL [@keyword] +%token ERASE [@keyword] [@contexts screen_descr_entry] +%token ERROR [@keyword] +%token ESCAPE [@keyword] +%token ESCAPE_BUTTON [@keyword] [@contexts ] +%token ESI [@keyword] +%token EVALUATE [@keyword] +%token EVENT [@keyword] +%token EVENT_LIST [@keyword] [@contexts ] +%token EVERY [@keyword] [@contexts ] +%token EXAMINE [@keyword] +%token EXCEPTION [@keyword] +%token EXCEPTION_OBJECT [@keyword] +%token EXCEPTION_VALUE [@keyword] [@contexts ] +%token EXCLUSIVE [@keyword] +%token EXCLUSIVE_OR [@keyword] +%token EXHIBIT [@keyword] +%token EXIT [@keyword] +%token EXPAND [@keyword] [@contexts ] +%token EXPANDS [@keyword] [@contexts class_specifier, interface_specifier] +%token EXTEND [@keyword] +%token EXTENDED_SEARCH [@keyword] [@contexts ] +%token EXTERN [@keyword] [@contexts ] +%token EXTERNAL [@keyword] +%token EXTERNAL_FORM [@keyword] +%token F [@keyword] [@contexts ] +%token FACTORY [@keyword] +%token FALSE [@keyword] +%token FARTHEST_FROM_ZERO [@keyword] +%token FD [@keyword] +%token FH__FCD [@keyword] [@contexts ] +%token FH__KEYDEF [@keyword] [@contexts ] +%token FILE [@keyword] +%token FILE_CONTROL [@keyword] +%token FILE_ID [@keyword] +%token FILE_LIMIT [@keyword] [@contexts ] +%token FILE_LIMITS [@keyword] [@contexts ] +%token FILE_NAME [@keyword] [@contexts ] +%token FILE_POS [@keyword] [@contexts ] +%token FILLER [@keyword] +%token FILL_COLOR [@keyword] [@contexts ] +%token FILL_COLOR2 [@keyword] [@contexts ] +%token FILL_PERCENT [@keyword] [@contexts ] +%token FINAL [@keyword] +%token FINALLY [@keyword] +%token FINISH_REASON [@keyword] [@contexts ] +%token FIRST [@keyword] +%token FIXED [@keyword] +%token FIXED_FONT [@keyword] +%token FIXED_WIDTH [@keyword] [@contexts ] +%token FLAT [@keyword] [@contexts ] +%token FLAT_BUTTONS [@keyword] [@contexts ] +%token FLOAT [@keyword] +%token FLOATING [@keyword] +%token FLOAT_BINARY [@keyword] [@contexts options_paragraph] +%token FLOAT_BINARY_128 [@keyword] +%token FLOAT_BINARY_32 [@keyword] +%token FLOAT_BINARY_64 [@keyword] +%token FLOAT_DECIMAL [@keyword] [@contexts options_paragrahp] +%token FLOAT_DECIMAL_16 [@keyword] +%token FLOAT_DECIMAL_34 [@keyword] +%token FLOAT_EXTENDED [@keyword] +%token FLOAT_INFINITY [@keyword] +%token FLOAT_LONG [@keyword] +%token FLOAT_NOT_A_NUMBER [@keyword] [@contexts ] +%token FLOAT_NOT_A_NUMBER_QUIET [@keyword] +%token FLOAT_NOT_A_NUMBER_SIGNALING [@keyword] +%token FLOAT_SHORT [@keyword] +%token FONT [@keyword] +%token FOOTING [@keyword] +%token FOR [@keyword] +%token FOREGROUND_COLOR [@keyword] [@contexts screen_descr_entry] +%token FOREVER [@keyword] [@contexts retry_phrase] +%token FORMAT [@keyword] +%token FRAME [@keyword] [@contexts ] +%token FRAMED [@keyword] [@contexts ] +%token FREE [@keyword] +%token FROM [@keyword] +%token FULL [@keyword] [@contexts screnn_descr_entry] +%token FULL_HEIGHT [@keyword] [@contexts ] +%token FUNCTION [@keyword] +%token FUNCTION_ID [@keyword] +%token FUNCTION_POINTER [@keyword] +%token GENERATE [@keyword] +%token GET [@keyword] +%token GIVING [@keyword] +%token GLOBAL [@keyword] +%token GO [@keyword] +%token GOBACK [@keyword] +%token GO_BACK [@keyword] [@contexts ] +%token GO_FORWARD [@keyword] [@contexts ] +%token GO_HOME [@keyword] [@contexts ] +%token GO_SEARCH [@keyword] [@contexts ] +%token GRAPHICAL [@keyword] [@contexts ] +%token GREATER [@keyword] +%token GRID [@keyword] [@contexts ] +%token GROUP [@keyword] +%token GROUP_USAGE [@keyword] +%token GROUP_VALUE [@keyword] [@contexts ] +%token HANDLE [@keyword] +%token HAS_CHILDREN [@keyword] [@contexts ] +%token HEADING [@keyword] +%token HEADING_COLOR [@keyword] [@contexts ] +%token HEADING_DIVIDER_COLOR [@keyword] [@contexts ] +%token HEADING_FONT [@keyword] [@contexts ] +%token HEAVY [@keyword] [@contexts ] +%token HEIGHT_IN_CELLS [@keyword] [@contexts ] +%token HEX [@keyword] [@contexts ] +%token HIDDEN_DATA [@keyword] +%token HIGHLIGHT [@keyword] [@contexts screen_descr_entry] +%token HIGH_COLOR [@keyword] [@contexts ] +%token HIGH_ORDER_LEFT [@keyword] [@contexts float_binary_clause, float_decimal_clause] +%token HIGH_ORDER_RIGHT [@keyword] [@contexts float_binary_clause, float_decimal_clause] +%token HIGH_VALUE [@keyword "HIGH-VALUE", "HIGH-VALUES"] +%token HOT_TRACK [@keyword] [@contexts ] +%token HSCROLL [@keyword] [@contexts ] +%token HSCROLL_POS [@keyword] [@contexts ] +%token ICON [@keyword] [@contexts ] +%token ID [@keyword] +%token IDENTIFICATION [@keyword] +%token IDENTIFIED [@keyword] +%token IF [@keyword] +%token IGNORE [@keyword] +%token IGNORING [@keyword] [@contexts read_statement] +%token IMPLEMENTS [@keyword] [@contexts factory_paragraph, object_paragraph] +%token IN [@keyword] +%token INDEPENDENT [@keyword] [@contexts ] +%token INDEX [@keyword] +%token INDEXED [@keyword] +%token INDICATE [@keyword] +%token INHERITS [@keyword] +%token INITIAL [@keyword] +%token INITIALIZE [@keyword] +%token INITIALIZED [@keyword] [@contexts allocate_stmt, occurs_clause] +%token INITIATE [@keyword] +%token INPUT [@keyword] +%token INPUT_OUTPUT [@keyword] +%token INQUIRE [@keyword] +%token INSERTION_INDEX [@keyword] [@contexts ] +%token INSERT_ROWS [@keyword] [@contexts ] +%token INSPECT [@keyword] +%token INTERFACE [@keyword] +%token INTERFACE_ID [@keyword] +%token INTERMEDIATE [@keyword] [@contexts options_pragraph] +%token INTO [@keyword] +%token INTRINSIC [@keyword] [@contexts function_specifier] +%token INVALID [@keyword] +%token INVOKE [@keyword] +%token IN_ARITHMETIC_RANGE [@keyword] +%token IS [@keyword] +%token ITEM [@keyword] [@contexts ] +%token ITEM_TEXT [@keyword] [@contexts ] +%token ITEM_TO_ADD [@keyword] [@contexts ] +%token ITEM_TO_DELETE [@keyword] [@contexts ] +%token ITEM_TO_EMPTY [@keyword] [@contexts ] +%token ITEM_VALUE [@keyword] [@contexts ] +%token I_O [@keyword] +%token I_O_CONTROL [@keyword] +%token JSON [@keyword] +%token JUSTIFIED [@keyword "JUST", "JUSTIFIED"] +%token KEPT [@keyword] +%token KEY [@keyword] +%token KEYBOARD [@keyword] [@contexts ] +%token LABEL [@keyword] +%token LABEL_OFFSET [@keyword] [@contexts ] +%token LARGE_FONT [@keyword] +%token LARGE_OFFSET [@keyword] [@contexts ] +%token LAST [@keyword] +%token LAST_ROW [@keyword] [@contexts ] +%token LAYOUT_DATA [@keyword] [@contexts ] +%token LAYOUT_MANAGER [@keyword] +%token LC_ALL [@keyword "LC_ALL" ] [@contexts set_stmt] +%token LC_COLLATE [@keyword "LC_COLLATE" ] [@contexts set_stmt] +%token LC_CTYPE [@keyword "LC_CTYPE" ] [@contexts set_stmt] +%token LC_MESSAGES [@keyword "LC_MESSAGES"] [@contexts set_stmt] +%token LC_MONETARY [@keyword "LC_MONETARY"] [@contexts set_stmt] +%token LC_NUMERIC [@keyword "LC_NUMERIC" ] [@contexts set_stmt] +%token LC_TIME [@keyword "LC_TIME" ] [@contexts set_stmt] +%token LEADING [@keyword] +%token LEADING_SHIFT [@keyword] [@contexts ] +%token LEAVE [@keyword] [@contexts ] +%token LEFT [@keyword] +%token LEFTLINE [@keyword] +%token LEFT_JUSTIFY [@keyword] +%token LEFT_TEXT [@keyword] [@contexts ] +%token LENGTH [@keyword] +%token LESS [@keyword] +%token LIBRARY [@keyword] +%token LIKE [@keyword] +%token LIMIT [@keyword] +%token LIMITS [@keyword] +%token LINAGE [@keyword] +%token LINAGE_COUNTER [@keyword] +%token LINE [@keyword] +%token LINES [@keyword] +%token LINES_AT_ROOT [@keyword] [@contexts ] +%token LINE_COUNTER [@keyword] +%token LINE_SEQUENTIAL [@keyword] [@contexts ] +%token LINKAGE [@keyword] +%token LIST_BOX [@keyword] [@contexts ] +%token LM_RESIZE [@keyword] +%token LOC [@keyword] [@contexts ] +%token LOCALE [@keyword] +%token LOCAL_STORAGE [@keyword] +%token LOCATION [@keyword] [@contexts ] +%token LOCK [@keyword] +%token LOCK_HOLDING [@keyword] [@contexts ] +%token LONG_DATE [@keyword] [@contexts ] +%token LOWER [@keyword] [@contexts ] +%token LOWERED [@keyword] [@contexts ] +%token LOWLIGHT [@keyword] [@contexts screen_descr_entry, set_attribute_stmt] +%token LOW_COLOR [@keyword] [@contexts ] +%token LOW_VALUE [@keyword "LOW-VALUE", "LOW-VALUES"] +%token MAGNETIC_TAPE [@keyword] [@contexts ] +%token MANUAL [@keyword] [@contexts lock_mode_clause] +%token MASS_UPDATE [@keyword] [@contexts ] +%token MASTER_INDEX [@keyword] [@contexts ] +%token MAX_LINES [@keyword] [@contexts ] +%token MAX_PROGRESS [@keyword] [@contexts ] +%token MAX_TEXT [@keyword] [@contexts ] +%token MAX_VAL [@keyword] [@contexts ] +%token MEDIUM_FONT [@keyword] +%token MEMORY [@keyword] [@contexts ] +%token MENU [@keyword] +%token MERGE [@keyword] +%token MESSAGE [@keyword] +%token MESSAGE_TAG [@keyword] +%token METHOD [@keyword] +%token METHOD_ID [@keyword] +%token MICROSECOND_TIME [@keyword] [@contexts ] +%token MINUS [@keyword] +%token MIN_VAL [@keyword] [@contexts ] +%token MODE [@keyword] +%token MODIFY [@keyword] +%token MODULES [@keyword] [@contexts ] +%token MOVE [@keyword] +%token MULTILINE [@keyword] [@contexts ] +%token MULTIPLE [@keyword] +%token MULTIPLY [@keyword] +%token NAME [@keyword] [@contexts ] +%token NAMED [@keyword] [@contexts ] +%token NAMESPACE [@keyword] [@contexts ] +%token NAMESPACE_PREFIX [@keyword] [@contexts ] +%token NAT [@keyword] [@contexts ] +%token NATIONAL [@keyword] +%token NATIONAL_EDITED [@keyword] +%token NATIVE [@keyword] +%token NAVIGATE_URL [@keyword] [@contexts ] +%token NEAREST_AWAY_FROM_ZERO [@keyword] [@contexts intermediate_rounding_clause, rounded_phrase] +%token NEAREST_EVEN [@keyword] [@contexts intermediate_rounding_clause, rounded_phrase] +%token NEAREST_TOWARD_ZERO [@keyword] [@contexts intermediate_rounding_clause, rounded_phrase] +%token NEAREST_TO_ZERO [@keyword] +%token NEGATIVE [@keyword] +%token NESTED [@keyword] +%token NEW [@keyword] +%token NEXT [@keyword] +%token NEXT_ITEM [@keyword] [@contexts ] +%token NO [@keyword] +%token NOMINAL [@keyword] [@contexts ] +%token NONE [@keyword] [@contexts default_clause] +%token NONNUMERIC [@keyword] [@contexts ] +%token NORMAL [@keyword] [@contexts stop_stmt] +%token NOT [@keyword] +%token NOTAB [@keyword] [@contexts ] +%token NOTHING [@keyword] +%token NOTIFY [@keyword] [@contexts ] +%token NOTIFY_CHANGE [@keyword] [@contexts ] +%token NOTIFY_DBLCLICK [@keyword] [@contexts ] +%token NOTIFY_SELCHANGE [@keyword] [@contexts ] +%token NO_AUTOSEL [@keyword] [@contexts ] +%token NO_AUTO_DEFAULT [@keyword] [@contexts ] +%token NO_BOX [@keyword] [@contexts ] +%token NO_DIVIDERS [@keyword] [@contexts ] +%token NO_ECHO [@keyword] +%token NO_F4 [@keyword] [@contexts ] +%token NO_FOCUS [@keyword] [@contexts ] +%token NO_GROUP_TAB [@keyword] [@contexts ] +%token NO_KEY_LETTER [@keyword] [@contexts ] +%token NO_SEARCH [@keyword] [@contexts ] +%token NO_UPDOWN [@keyword] [@contexts ] +%token NULL [@keyword] +%token NULLS [@keyword] +%token NUMBER [@keyword] +%token NUMBERS [@keyword] [@contexts column_clause, line_clause] +%token NUMERIC [@keyword] +%token NUMERIC_EDITED [@keyword] +%token NUM_COL_HEADINGS [@keyword] [@contexts ] +%token NUM_ROWS [@keyword] [@contexts ] +%token OBJECT [@keyword] +%token OBJECT_COMPUTER [@keyword] +%token OBJECT_REFERENCE [@keyword] +%token OCCURS [@keyword] +%token OF [@keyword] +%token OFF [@keyword] +%token OK_BUTTON [@keyword] [@contexts ] +%token OMITTED [@keyword] +%token ON [@keyword] +%token ONLY [@keyword] [@contexts sharing_clause, sharing_phrase, usage_clause] +%token OPEN [@keyword] +%token OPTIONAL [@keyword] +%token OPTIONS [@keyword] +%token OR [@keyword] +%token ORDER [@keyword] +%token ORGANIZATION [@keyword] +%token OTHER [@keyword] +%token OTHERS [@keyword] [@contexts ] +%token OUTPUT [@keyword] +%token OVERFLOW [@keyword] +%token OVERLAP_LEFT [@keyword] [@contexts ] +%token OVERLAP_TOP [@keyword] [@contexts ] +%token OVERLINE [@keyword] +%token OVERRIDE [@keyword] +%token PACKED_DECIMAL [@keyword] +%token PADDING [@keyword] +%token PAGE [@keyword] [@contexts ] +%token PAGED [@keyword] +%token PAGE_COUNTER [@keyword] +%token PAGE_SETUP [@keyword] [@contexts ] +%token PARAGRAPH [@keyword] [@contexts exit_stmt] +%token PARENT [@keyword] [@contexts ] +%token PARSE [@keyword] [@contexts ] +%token PASCAL [@keyword] [@contexts ] +%token PASSWORD [@keyword] [@contexts ] +%token PERFORM [@keyword] +%token PERMANENT [@keyword] [@contexts ] +%token PF [@keyword] +%token PH [@keyword] +%token PHYSICAL [@keyword] +%token PICTURE [@keyword "PIC", "PICTURE"] +%token PIXEL [@keyword] [@contexts ] +%token PLACEMENT [@keyword] [@contexts ] +%token PLUS [@keyword] +%token POINTER [@keyword] +%token POP_UP [@keyword] [@contexts ] +%token POS [@keyword] [@contexts ] +%token POSITION [@keyword] +%token POSITION_SHIFT [@keyword] [@contexts ] +%token POSITIVE [@keyword] +%token PREFIXED [@keyword] [@contexts dynlen_struct_clause] +%token PRESENT [@keyword] +%token PREVIOUS [@keyword] [@contexts read_stmt] +%token PRINT [@keyword] [@contexts ] +%token PRINTER [@keyword] [@contexts ] +%token PRINTER_1 [@keyword] [@contexts ] +%token PRINTING [@keyword] +%token PRINT_NO_PROMPT [@keyword] [@contexts ] +%token PRINT_PREVIEW [@keyword] [@contexts ] +%token PRIORITY [@keyword] +%token PROCEDURE [@keyword] +%token PROCEDURES [@keyword] +%token PROCEDURE_POINTER [@keyword] +%token PROCEED [@keyword] +%token PROCESSING [@keyword] [@contexts ] +%token PROGRAM [@keyword] +%token PROGRAM_ID [@keyword] +%token PROGRAM_POINTER [@keyword] +%token PROGRESS [@keyword] [@contexts ] +%token PROHIBITED [@keyword] [@contexts intermediate_rounding_clause, rounded_phrase] +%token PROMPT [@keyword] +%token PROPERTIES [@keyword] [@contexts ] +%token PROPERTY [@keyword] +%token PROTECTED [@keyword] [@contexts ] +%token PROTOTYPE [@keyword] +%token PURGE [@keyword] +%token PUSH_BUTTON [@keyword] [@contexts ] +%token QUERY_INDEX [@keyword] [@contexts ] +%token QUEUE [@keyword] +%token QUOTE [@keyword "QUOTE", "QUOTES"] +%token RADIO_BUTTON [@keyword] [@contexts ] +%token RAISE [@keyword] +%token RAISED [@keyword] [@contexts ] +%token RAISING [@keyword] +%token RANDOM [@keyword] +%token RD [@keyword] +%token READ [@keyword] +%token READERS [@keyword] [@contexts ] +%token READ_ONLY [@keyword] [@contexts ] +%token RECEIVE [@keyword] +%token RECEIVED [@keyword] +%token RECORD [@keyword] +%token RECORDING [@keyword] +%token RECORDS [@keyword] +%token RECORD_DATA [@keyword] [@contexts ] +%token RECORD_OVERFLOW [@keyword] [@contexts ] +%token RECORD_TO_ADD [@keyword] [@contexts ] +%token RECORD_TO_DELETE [@keyword] [@contexts ] +%token RECURSIVE [@keyword] [@contexts program_id_paragraph] +%token REDEFINES [@keyword] +%token REEL [@keyword] +%token REFERENCE [@keyword] +%token REFERENCES [@keyword] +%token REFRESH [@keyword] [@contexts ] +%token REGION_COLOR [@keyword] [@contexts ] +%token RELATION [@keyword] [@contexts validate_status_clause] +%token RELATIVE [@keyword] +%token RELEASE [@keyword] +%token REMAINDER [@keyword] +%token REMOVAL [@keyword] +%token RENAMES [@keyword] +%token REORG_CRITERIA [@keyword] [@contexts ] +%token REPEATED [@keyword] +%token REPLACE [@keyword] +%token REPLACING [@keyword] +%token REPORT [@keyword] +%token REPORTING [@keyword] +%token REPORTS [@keyword] +%token REPOSITORY [@keyword] +%token REQUIRED [@keyword] [@contexts screen_descr_entry] +%token REREAD [@keyword] [@contexts ] +%token RERUN [@keyword] [@contexts ] +%token RESERVE [@keyword] +%token RESET [@keyword] +%token RESET_GRID [@keyword] [@contexts ] +%token RESET_LIST [@keyword] [@contexts ] +%token RESET_TABS [@keyword] [@contexts ] +%token RESUME [@keyword] +%token RETRY [@keyword] +%token RETURN [@keyword] +%token RETURNING [@keyword] +%token REVERSE [@keyword] +%token REVERSED [@keyword] +%token REVERSE_VIDEO [@keyword] [@contexts screen_descr_entry, set_attribute_stmt] +%token REWIND [@keyword] +%token REWRITE [@keyword] +%token RF [@keyword] +%token RH [@keyword] +%token RIGHT [@keyword] +%token RIGHT_ALIGN [@keyword] [@contexts ] +%token RIGHT_JUSTIFY [@keyword] +%token RIMMED [@keyword] [@contexts ] +%token ROLLBACK [@keyword] +%token ROUNDED [@keyword] +%token ROUNDING [@keyword] [@contexts options_paragraph] +%token ROW_COLOR [@keyword] [@contexts ] +%token ROW_COLOR_PATTERN [@keyword] [@contexts ] +%token ROW_DIVIDERS [@keyword] [@contexts ] +%token ROW_FONT [@keyword] [@contexts ] +%token ROW_HEADINGS [@keyword] [@contexts ] +%token ROW_PROTECTION [@keyword] [@contexts ] +%token RUN [@keyword] +%token S [@keyword] [@contexts ] +%token SAME [@keyword] +%token SAVE_AS [@keyword] [@contexts ] +%token SAVE_AS_NO_PROMPT [@keyword] [@contexts ] +%token SCREEN [@keyword] +%token SCROLL [@keyword] [@contexts ] +%token SCROLL_BAR [@keyword] [@contexts ] +%token SD [@keyword] +%token SEARCH [@keyword] +%token SEARCH_OPTIONS [@keyword] [@contexts ] +%token SEARCH_TEXT [@keyword] [@contexts ] +%token SECONDS [@keyword] [@contexts retry_phrase] +%token SECTION [@keyword] +%token SECURE [@keyword] [@contexts screen_descr_entry] +%token SEGMENT [@keyword] +%token SEGMENT_LIMIT [@keyword] +%token SELECT [@keyword] +%token SELECTION_INDEX [@keyword] [@contexts ] +%token SELECTION_TEXT [@keyword] [@contexts ] +%token SELECT_ALL [@keyword] [@contexts ] +%token SELF [@keyword] +%token SELF_ACT [@keyword] [@contexts ] +%token SEND [@keyword] +%token SENTENCE [@keyword] +%token SEPARATE [@keyword] +%token SEPARATION [@keyword] [@contexts ] +%token SEQUENCE [@keyword] +%token SEQUENTIAL [@keyword] +%token SET [@keyword] +%token SHADING [@keyword] [@contexts ] +%token SHADOW [@keyword] [@contexts ] +%token SHARING [@keyword] +%token SHORT [@keyword] [@contexts dynlen_struct_clause] +%token SHORT_DATE [@keyword] +%token SHOW_LINES [@keyword] [@contexts ] +%token SHOW_NONE [@keyword] [@contexts ] +%token SHOW_SEL_ALWAYS [@keyword] [@contexts ] +%token SIGN [@keyword] +%token SIGNED [@keyword] [@contexts dynlen_struct_clause, usage_clause] +%token SIGNED_INT [@keyword] +%token SIGNED_LONG [@keyword] +%token SIGNED_SHORT [@keyword] +%token SIZE [@keyword] +%token SMALL_FONT [@keyword] +%token SORT [@keyword] +%token SORT_MERGE [@keyword] +%token SORT_ORDER [@keyword] [@contexts ] +%token SOURCE [@keyword] +%token SOURCES [@keyword] +%token SOURCE_COMPUTER [@keyword] +%token SPACE [@keyword "SPACE", "SPACES"] +%token SPACE_FILL [@keyword] +%token SPECIAL_NAMES [@keyword] +%token SPINNER [@keyword] [@contexts ] +%token SQUARE [@keyword] [@contexts ] +%token STACK [@keyword] [@contexts ] +%token STANDARD [@keyword] +%token STANDARD_1 [@keyword] +%token STANDARD_2 [@keyword] +%token STANDARD_BINARY [@keyword] [@contexts arithmetic_clause] +%token STANDARD_DECIMAL [@keyword] [@contexts arithmetic_clause] +%token START [@keyword] +%token START_X [@keyword] [@contexts ] +%token START_Y [@keyword] [@contexts ] +%token STATEMENT [@keyword] [@contexts resume_stmt] +%token STATIC [@keyword] [@contexts ] +%token STATIC_LIST [@keyword] [@contexts ] +%token STATUS [@keyword] +%token STATUS_BAR [@keyword] [@contexts ] +%token STATUS_TEXT [@keyword] [@contexts ] +%token STDCALL [@keyword] [@contexts ] +%token STEP [@keyword] [@contexts occurs_clause] +%token STOP [@keyword] +%token STRING [@keyword] +%token STRONG [@keyword] [@contexts typedef_clause] +%token STRUCTURE [@keyword] [@contexts dynlen_struct_clause] +%token STYLE [@keyword] [@contexts ] +%token SUBTRACT [@keyword] +%token SUBWINDOW [@keyword] +%token SUB_QUEUE_1 [@keyword] +%token SUB_QUEUE_2 [@keyword] +%token SUB_QUEUE_3 [@keyword] +%token SUM [@keyword] +%token SUPER [@keyword] +%token SUPPRESS [@keyword] +%token SWITCH [@keyword] +%token SYMBOL [@keyword] [@contexts currency_clause] +%token SYMBOLIC [@keyword] +%token SYNCHRONIZED [@keyword "SYNC", "SYNCHRONIZED"] +%token SYSTEM_DEFAULT [@keyword] +%token SYSTEM_INFO [@keyword] [@contexts ] +%token SYSTEM_OFFSET [@keyword] +%token TAB [@keyword] [@contexts ] +%token TABLE [@keyword] +%token TAB_TO_ADD [@keyword] [@contexts ] +%token TAB_TO_DELETE [@keyword] [@contexts ] +%token TALLYING [@keyword] +%token TAPE [@keyword] [@contexts ] +%token TEMPORARY [@keyword] [@contexts ] +%token TERMINAL [@keyword] +%token TERMINAL_INFO [@keyword] [@contexts ] +%token TERMINATE [@keyword] +%token TERMINATION_VALUE [@keyword] [@contexts ] +%token TEST [@keyword] +%token TEXT [@keyword] +%token THAN [@keyword] +%token THEN [@keyword] +%token THREAD [@keyword] +%token THREADS [@keyword] +%token THREEDIMENSIONAL [@keyword "3-D"] [@contexts ] +%token THROUGH [@keyword "THROUGH", "THRU"] +%token THUMB_POSITION [@keyword] [@contexts ] +%token TILED_HEADINGS [@keyword] [@contexts ] +%token TIME [@keyword] +%token TIMES [@keyword] +%token TIME_OUT [@keyword] [@contexts ] +%token TITLE [@keyword] [@contexts ] +%token TITLE_POSITION [@keyword] [@contexts ] +%token TO [@keyword] +%token TOP [@keyword] +%token TOP_LEVEL [@keyword] [@contexts ] +%token TOWARD_GREATER [@keyword] [@contexts rounded_phrase] +%token TOWARD_LESSER [@keyword] [@contexts rounded_phrase] +%token TRACK [@keyword] [@contexts ] +%token TRACKS [@keyword] [@contexts ] +%token TRACK_AREA [@keyword] [@contexts ] +%token TRACK_LIMIT [@keyword] [@contexts ] +%token TRADITIONAL_FONT [@keyword] +%token TRAILING [@keyword] +%token TRAILING_SHIFT [@keyword] [@contexts ] +%token TRAILING_SIGN [@keyword] +%token TRANSFORM [@keyword] +%token TRANSPARENT [@keyword] [@contexts ] +%token TREE_VIEW [@keyword] [@contexts ] +%token TRUE [@keyword] +%token TRUNCATION [@keyword] [@contexts intermediate_rounding_clause, rounded_phrase] +%token TYPE [@keyword] +%token TYPEDEF [@keyword] +%token U [@keyword] [@contexts ] +%token UCS_4 [@keyword] [@contexts alphabet_clause] +%token UNBOUNDED [@keyword] [@contexts ] +%token UNDERLINE [@keyword] [@contexts screen_descr_entry, set_attribute_stmt] +%token UNFRAMED [@keyword] [@contexts ] +%token UNIT [@keyword] +%token UNIVERSAL [@keyword] +%token UNLOCK [@keyword] +%token UNSIGNED [@keyword] [@contexts usage_clause] +%token UNSIGNED_INT [@keyword] +%token UNSIGNED_LONG [@keyword] +%token UNSIGNED_SHORT [@keyword] +%token UNSORTED [@keyword] [@contexts ] +%token UNSTRING [@keyword] +%token UNTIL [@keyword] +%token UP [@keyword] +%token UPDATE [@keyword] +%token UPDATERS [@keyword] [@contexts ] +%token UPON [@keyword] +%token UPPER [@keyword] [@contexts ] +%token USAGE [@keyword] +%token USE [@keyword] +%token USER [@keyword] [@contexts ] +%token USER_DEFAULT [@keyword] +%token USE_ALT [@keyword] [@contexts ] +%token USE_RETURN [@keyword] [@contexts ] +%token USE_TAB [@keyword] [@contexts ] +%token USING [@keyword] +%token UTF_16 [@keyword] [@contexts alphabet_clause] +%token UTF_8 [@keyword] [@contexts alphabet_clause] +%token V [@keyword] [@contexts ] +%token VALID [@keyword] +%token VALIDATE [@keyword] +%token VALIDATE_STATUS [@keyword "VALIDATE-STATUS", "VAL-STATUS"] +%token VALIDATING [@keyword] [@contexts ] +%token VALUE [@keyword] +%token VALUES [@keyword] +%token VALUE_FORMAT [@keyword] [@contexts ] +%token VARIABLE [@keyword] [@contexts ] +%token VARIANT [@keyword] +%token VARYING [@keyword] +%token VERTICAL [@keyword] [@contexts ] +%token VERY_HEAVY [@keyword] [@contexts ] +%token VIRTUAL_WIDTH [@keyword] [@contexts ] +%token VOLATILE [@keyword] +%token VPADDING [@keyword] [@contexts ] +%token VSCROLL [@keyword] [@contexts ] +%token VSCROLL_BAR [@keyword] [@contexts ] +%token VSCROLL_POS [@keyword] [@contexts ] +%token VTOP [@keyword] [@contexts ] +%token WAIT [@keyword] +%token WEB_BROWSER [@keyword] [@contexts ] +%token WHEN [@keyword] +%token WIDTH [@keyword] [@contexts ] +%token WIDTH_IN_CELLS [@keyword] [@contexts ] +%token WINDOW [@keyword] +%token WITH [@keyword] +%token WORDS [@keyword] +%token WORKING_STORAGE [@keyword] +%token WRAP [@keyword] [@contexts ] +%token WRITE [@keyword] +%token WRITERS [@keyword] [@contexts ] +%token WRITE_ONLY [@keyword] [@contexts ] +%token WRITE_VERIFY [@keyword] [@contexts ] +%token X [@keyword] [@contexts ] +%token XML [@keyword] +%token XML_DECLARATION [@keyword] [@contexts ] +%token XML_SCHEMA [@keyword] [@contexts ] +%token XOR [@keyword] +%token Y [@keyword] [@contexts ] +%token YYYYDDD [@keyword] [@contexts accept_stmt] +%token YYYYMMDD [@keyword] [@contexts accept_stmt] +%token ZERO [@keyword "ZERO", "ZEROES", "ZEROS"] +%token ZERO_FILL [@keyword] [@contexts ] + +%token AUTHOR [@keyword] [@recovery "_"] +%token DATE_COMPILED [@keyword] [@recovery "_"] +%token DATE_MODIFIED [@keyword] [@recovery "_"] +%token DATE_WRITTEN [@keyword] [@recovery "_"] +%token INSTALLATION [@keyword] [@recovery "_"] +%token REMARKS [@keyword] [@recovery "_"] +%token SECURITY [@keyword] [@recovery "_"] + +(* + exception names are context-sensitive: can only appear in + RAISE, RAISING, USE EXCEPTION, and in the TURN directives *) + +(* Combined tokens for errors *) +%token ON_EXCEPTION +%token NOT_ON_EXCEPTION +%token ON_SIZE_ERROR +%token NOT_ON_SIZE_ERROR +%token ON_OVERFLOW +%token NOT_ON_OVERFLOW +%token INVALID_KEY +%token NOT_INVALID_KEY +%token AT_END +%token NOT_AT_END +%token AT_EOP +%token NOT_AT_EOP +%token WITH_DATA +%token NO_DATA + +(* Combined WITH tokens *) +(* %token WITH_LOCK_ON *) + +(* Combined IS tokens *) +%token IS_GLOBAL +%token IS_EXTERNAL +%token IS_TYPEDEF + +(* Combined NEXT tokens *) +%token NEXT_PAGE + +(* Combined DATA tokens *) +%token DATA_RECORD +%token DATA_RECORDS + +(* Special token for retokenizations after `DECIMAL-POINT IS COMMA` in + `SPECIAL-NAMES`; should never be fed to the parser (see Text_tokenizer and + Parser_engine). *) +%token INTERVENING_ + + +(* Additional (unused yet) *) + +%token ALIAS [@keyword.silenced] +%token ALTERING [@keyword.silenced] +%token ANSI [@keyword.silenced] +%token ASA [@keyword.silenced] +%token BECOMES [@keyword.silenced] +%token BEGINNING [@keyword.silenced] +%token BITS [@keyword.silenced] +%token BSN [@keyword.silenced] +%token B_EXOR [@keyword.silenced] +%token CATALOGUED [@keyword.silenced] +%token CATALOGUE_NAME [@keyword.silenced] +%token CHECK [@keyword.silenced] +%token CHECKPOINT_FILE [@keyword.silenced] +%token COMPLE [@keyword.silenced] +%token COMPLEMENTARY [@keyword.silenced] +%token COMPUTATIONAL_11 [@keyword.silenced] +%token COMPUTATIONAL_12 [@keyword.silenced] +%token COMPUTATIONAL_13 [@keyword.silenced] +%token COMPUTATIONAL_14 [@keyword.silenced] +%token COMPUTATIONAL_7 [@keyword.silenced] +%token COMP_11 [@keyword.silenced] +%token COMP_12 [@keyword.silenced] +%token COMP_13 [@keyword.silenced] +%token COMP_14 [@keyword.silenced] +%token COMP_7 [@keyword.silenced] +%token CONNECT [@keyword.silenced] +%token CONSOLE_0 [@keyword.silenced] +%token CONSOLE_1 [@keyword.silenced] +%token CONSOLE_2 [@keyword.silenced] +%token CONSOLE_3 [@keyword.silenced] +%token CS_BASIC [@keyword.silenced] +%token CS_GENERAL [@keyword.silenced] +%token DEBUG_CONTENTS [@keyword.silenced] +%token DEBUG_ITEM [@keyword.silenced] +%token DEBUG_LINE [@keyword.silenced] +%token DEBUG_NAME [@keyword.silenced] +%token DEBUG_SUB_1 [@keyword.silenced] +%token DEBUG_SUB_2 [@keyword.silenced] +%token DEBUG_SUB_3 [@keyword.silenced] +%token DISCONNECT [@keyword.silenced] +%token DISPLAY_2 [@keyword.silenced] +%token DISPLAY_3 [@keyword.silenced] +%token DISPLAY_4 [@keyword.silenced] +%token ENDING [@keyword.silenced] +%token FILES [@keyword.silenced] +%token FLR [@keyword.silenced] +%token GCOS [@keyword.silenced] +%token IDS_II [@keyword.silenced] +%token INDEX_1 [@keyword.silenced] +%token INDEX_2 [@keyword.silenced] +%token INVOKING [@keyword.silenced] +%token KEYED [@keyword.silenced] +%token KEY_LOCATION [@keyword.silenced] +%token LINES_PER_PAGE [@keyword.silenced] +%token LOCKS [@keyword.silenced] +%token OBJECT_PROGRAM [@keyword.silenced] +%token OPERATIONAL [@keyword.silenced] +%token OVERRIDING [@keyword.silenced] +%token PRIMARY [@keyword.silenced] +%token PROCESS_AREA [@keyword.silenced] +%token QUEUED [@keyword.silenced] +%token RETENTION [@keyword.silenced] +%token SARF [@keyword.silenced] +%token SECONDARY [@keyword.silenced] +%token SELECTION [@keyword.silenced] +%token SSF [@keyword.silenced] +%token STATION [@keyword.silenced] +%token SUB_SCHEMA [@keyword.silenced] +%token SYSIN_0 [@keyword.silenced] +%token SYSIN_1 [@keyword.silenced] +%token SYSIN_2 [@keyword.silenced] +%token SYSIN_3 [@keyword.silenced] +%token SYSIN_X [@keyword.silenced] +%token SYSOUT_0 [@keyword.silenced] +%token SYSOUT_1 [@keyword.silenced] +%token SYSOUT_2 [@keyword.silenced] +%token SYSOUT_3 [@keyword.silenced] +%token SYSOUT_X [@keyword.silenced] +%token SYSTEM [@keyword.silenced] +%token TEMP [@keyword.silenced] +%token TERMINAL_0 [@keyword.silenced] +%token TERMINAL_1 [@keyword.silenced] +%token TERMINAL_2 [@keyword.silenced] +%token TERMINAL_3 [@keyword.silenced] +%token TERMINAL_X [@keyword.silenced] +%token UFF [@keyword.silenced] +%token UNSEQUAL [@keyword.silenced] +%token VIA [@keyword.silenced] +%token VIRTUAL [@keyword.silenced] +%token VLR [@keyword.silenced] + +%% diff --git a/src/lsp/cobol_parser/grammar_utils.ml b/src/lsp/cobol_parser/grammar_utils.ml new file mode 100644 index 000000000..8a9ed0e55 --- /dev/null +++ b/src/lsp/cobol_parser/grammar_utils.ml @@ -0,0 +1,90 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_ast + +(* Note: we can share the same source overlay manager across several parsers as + long as we don't parse localized tokens using multiple instances of the + parser and in parallel. If that were to change, the manager would need to be + passed as parameter to the grammar. *) +module Overlay_manager = + Cobol_preproc.Src_overlay.New_manager (struct + let name = __MODULE__ + end) + +let neg_cond neg : simple_condition -> condition = + if not neg then UPCAST.simple_cond else fun c -> Not c +and neg_cond' neg : condition -> condition = + if not neg then Fun.id else fun c -> Not c + +(** Suffix of non-parenthesized relational combined conditions, to decypher + abbreviations *) +type flat_combination_operand = + | FlatAmbiguous of relop option * expression (* relop? e *) + | FlatNotExpr of expression (* NOT e *) + | FlatRel of bool * (expression * relop * expression) (* NOT? rel *) + | FlatOther of condition (* extended- or parenthesized condition *) + | FlatComb of (flat_combination_operand as 'x) * logop * 'x (* _ AND/OR _ *) + +(** [expand_relation_condition neg relation_condition logop_n_flatop] expands + the non-parenthesized relation condition encoded by: + + - {i [relation_condition]} (or {i NOT [relation_condition]} if [neg] holds) + if [logop_n_flatop] is [None]; + + - {i [relation_condition] [logop] abbrev-combined-conditions} (or {i NOT + [relation_condition] [logop] abbrev-combined-conditions} if [neg] holds), + where [logop] and {i abbrev-combined-conditions} are given via + [logop_n_flatop]. *) +let expand_relation_condition = + let rec disambiguate ?cond_prefix flatop sr = + (* Recursively constructs a valid condition based on the non-parenthesized + relational combined condition [flatop], assuming [sr] is the most recent + subject and relation operator (when reading from the left of the + sentence, canceling out on non-relational conditions). + + If [cond_prefix] is given, places it with a conjunction at the + bottom-left of the result, i.e, substitutes the bottom-left node [c] with + [Logop (cond_prefix, LAnd, c)]. *) + let c, sr = match flatop, sr with + | FlatAmbiguous (Some rel, e), Some (subj, _) + | FlatAmbiguous (None, e), Some (subj, rel) -> + UPCAST.simple_cond @@ Relation (subj, rel, e), Some (subj, rel) + | FlatAmbiguous (_, e), None -> + Expr e, sr + | FlatNotExpr e, Some (subj, rel) -> + Not (UPCAST.simple_cond @@ Relation (subj, rel, e)), sr + | FlatNotExpr e, None -> + Not (UPCAST.simple_cond @@ Expr e), sr + | FlatRel (neg, (e1, rel, e2)), _ -> + neg_cond' neg @@ Relation (e1, rel, e2), Some (e1, rel) + | FlatOther c, _ -> + c, None + | FlatComb (f1, logop, f2), sr -> + let c1, sr = disambiguate ?cond_prefix f1 sr in + let c2, sr = disambiguate f2 sr in + Logop (c1, logop, c2), sr + in + match flatop, cond_prefix with + | FlatComb _, _ | _, None -> c, sr + | _, Some c0 -> Logop (c0, LAnd, c), sr + in + fun neg (e1, relop, e2) -> + let c0 = neg_cond' neg @@ Relation (e1, relop, e2) in + function + | None -> + c0 + | Some (LOr, flatop) -> + Logop (c0, LOr, fst @@ disambiguate flatop (Some (e1, relop))) + | Some (LAnd, flatop) -> + fst @@ disambiguate ~cond_prefix:c0 flatop (Some (e1, relop)) diff --git a/src/lsp/cobol_parser/grammar_utils.mli b/src/lsp/cobol_parser/grammar_utils.mli new file mode 100644 index 000000000..e6a47788a --- /dev/null +++ b/src/lsp/cobol_parser/grammar_utils.mli @@ -0,0 +1,44 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_ast + +module Overlay_manager: Cobol_preproc.Src_overlay.MANAGER + +val neg_cond: bool -> simple_condition -> condition +val neg_cond': bool -> condition -> condition + +(** Suffix of non-parenthesized relational combined conditions, to decypher + abbreviations *) +type flat_combination_operand = + | FlatAmbiguous of relop option * expression (* relop? e *) + | FlatNotExpr of expression (* NOT e *) + | FlatRel of bool * (expression * relop * expression) (* NOT? rel *) + | FlatOther of condition (* extended- or parenthesized condition *) + | FlatComb of (flat_combination_operand as 'x) * logop * 'x (* _ AND/OR _ *) + +(** [expand_relation_condition neg relation_condition logop_n_flatop] expands + the non-parenthesized relation condition encoded by: + + - {i [relation_condition]} (or {i NOT [relation_condition]} if [neg] holds) + if [logop_n_flatop] is [None]; + + - {i [relation_condition] [logop] abbrev-combined-conditions} (or {i NOT + [relation_condition] [logop] abbrev-combined-conditions} if [neg] holds), + where [logop] and {i abbrev-combined-conditions} are given via + [logop_n_flatop]. *) +val expand_relation_condition + : bool + -> expression * relop * expression + -> (logop * flat_combination_operand) option + -> condition diff --git a/src/lsp/cobol_parser/index.mld b/src/lsp/cobol_parser/index.mld new file mode 100644 index 000000000..fb856c521 --- /dev/null +++ b/src/lsp/cobol_parser/index.mld @@ -0,0 +1,10 @@ +{1 Library cobol_parser} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package contains all the parsing logic and grammar definitions. as well as our Menhir extensions +used to parse COBOL. + +The entry point of this library is the module: {!Cobol_parser}. + diff --git a/src/lsp/cobol_parser/keywords/dune b/src/lsp/cobol_parser/keywords/dune new file mode 100644 index 000000000..377e6efa7 --- /dev/null +++ b/src/lsp/cobol_parser/keywords/dune @@ -0,0 +1,3 @@ +(executable + (name gen_keywords) + (libraries unix fmt menhirSdk)) diff --git a/src/lsp/cobol_parser/keywords/gen_keywords.ml b/src/lsp/cobol_parser/keywords/gen_keywords.ml new file mode 100644 index 000000000..b8ce96300 --- /dev/null +++ b/src/lsp/cobol_parser/keywords/gen_keywords.ml @@ -0,0 +1,121 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let cmlyname = ref None +let external_tokens = ref "" + +let usage_msg = Fmt.str "%s [OPTIONS] file.cmly" Sys.argv.(0) +let anon str = match !cmlyname with + | None -> cmlyname := Some str + | Some _ -> raise @@ Arg.Bad "Only one anonymous argument may be given" + +let () = + Arg.parse + Arg.[ + ("--external-tokens", Set_string external_tokens, + " Import token type definition from "); + ] + anon usage_msg + +let cmlyname = match !cmlyname with + | None | Some "" -> Fmt.epr "%s@." usage_msg; exit 1 + | Some s -> s + +(* --- *) + +include MenhirSdk.Cmly_read.Read (struct let filename = cmlyname end) + +let tokens_module = match !external_tokens with + | "" -> String.capitalize_ascii @@ Filename.basename Grammar.basename + | s -> s + +let emit_prelude ppf = + List.iter begin fun a -> + if Attribute.has_label "header" a || + Attribute.has_label "keyword.header" a then + Format.fprintf ppf "%s\n" (Attribute.payload a) + end Grammar.attributes + +let punct attrs = + (* Note: we reuse the symbol attribute used by the printer. *) + List.find_opt (Attribute.has_label "symbol") attrs |> + Option.map Attribute.payload + +let keyword attrs = + List.find_opt (Attribute.has_label "keyword") attrs |> + Option.map Attribute.payload + +let silenced attrs = + List.find_opt (Attribute.has_label "keyword.silenced") attrs |> + Option.map Attribute.payload + +let pp_terminal ppf t = + Print.terminal ppf t; + match Terminal.typ t with + | None -> () + | Some "string" -> Fmt.string ppf " \"\"" + | Some "int" -> Fmt.string ppf " 0" + | Some t -> Fmt.failwith "unsupported token type: %s" t + +let emit_entry attribute_payload ?(comment_token = false) ppf t = + let start_token ppf = if comment_token then Fmt.string ppf "(*" + and end_token ppf = if comment_token then Fmt.string ppf "*)" in + match Terminal.kind t with + | `ERROR | `EOF | `PSEUDO -> + () (* ignore *) + | `REGULAR -> + match attribute_payload (Terminal.attributes t) with + | None -> + () + | Some payload when String.trim payload = "" -> (* auto-generate *) + Fmt.pf ppf "@\n\"%s\"%t, %a%t;" + (String.map (function '_' -> '-' | c -> c) (Terminal.name t)) + start_token pp_terminal t end_token + | Some payload -> + List.iter + (fun kwd -> Fmt.pf ppf "@\n%s%t, %a%t;" (String.trim kwd) + start_token pp_terminal t end_token) + (String.split_on_char ',' payload) + +let emit_keywords_list ppf = + Fmt.pf ppf "@[<2>let keywords = %s.[" tokens_module; + Terminal.iter (emit_entry keyword ~comment_token:false ppf); + Fmt.pf ppf "@]@\n]@." + +let emit_puncts_list ppf = + Fmt.pf ppf "@[<2>let puncts = %s.[" tokens_module; + Terminal.iter (emit_entry punct ~comment_token:false ppf); + Fmt.pf ppf "@]@\n]@." + +let emit_silenced_keywords_list ppf = + Fmt.pf ppf "@[<2>let silenced_keywords = %s.[" tokens_module; + Terminal.iter (emit_entry silenced ~comment_token:true ppf); + Fmt.pf ppf "@]@\n]@." + +let emit ppf = + Fmt.pf ppf + "(* Caution: this file was automatically generated from %s; do not edit *)\ + @\n[@@@@@@warning \"-33\"] (* <- do not warn on unused opens *)\ + @\n%t\ + @\n%t\ + @\n%t\ + @\n%t\ + @\n" + cmlyname + emit_prelude + emit_keywords_list + emit_puncts_list + emit_silenced_keywords_list + +let () = + emit Fmt.stdout diff --git a/src/lsp/cobol_parser/pTree.ml b/src/lsp/cobol_parser/pTree.ml new file mode 100644 index 000000000..87c7c1fb5 --- /dev/null +++ b/src/lsp/cobol_parser/pTree.ml @@ -0,0 +1,46 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +type 'a with_loc = 'a Cobol_common.Srcloc.with_loc = + { payload: 'a; loc: Cobol_common.Srcloc.srcloc; } +open Cobol_common.Srcloc.INFIX + +(** Parse tree: raw AST with pictures represented using plain, unchecked + strings. *) + +module Misc_sections = + Cobol_ast.Raw.Misc_sections +module Picture = struct + type picture = string with_loc + let pp_picture fmt str = Pretty.string fmt (~&str) + let show_picture = Pretty.to_string "%a" pp_picture +end +module Data_sections = + Cobol_ast.Raw.Data_sections (Picture) +module Data_division = + Cobol_ast.Raw.Data_division (Data_sections) +module Statements = + Cobol_ast.Raw.Statements +module Proc_division = + Cobol_ast.Raw.Proc_division (Statements) +module Compilation_group = + Cobol_ast.Raw.Compilation_group + (Misc_sections) (Data_division) (Proc_division) + +include Compilation_group +include Proc_division +include Statements +include Data_division +include Data_sections +include Picture +include Misc_sections diff --git a/src/lsp/cobol_parser/pTree_visitor.ml b/src/lsp/cobol_parser/pTree_visitor.ml new file mode 100644 index 000000000..d93800fe5 --- /dev/null +++ b/src/lsp/cobol_parser/pTree_visitor.ml @@ -0,0 +1,83 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module For_misc_sections = + Cobol_ast.Raw_visitor.Make_for_misc_sections + +module For_picture = struct + include Cobol_ast.Abstract_visitor.For_picture (PTree.Picture) + let fold_picture (v: _ #folder) = Cobol_common.Visitor.leaf v#fold_picture +end + +module For_data_sections = + Cobol_ast.Raw_visitor.Make_for_data_sections (PTree.Picture) + +module For_data_division = + Cobol_ast.Raw_visitor.Make_for_data_division (PTree.Data_sections) + +module For_statements = + Cobol_ast.Raw_visitor.Make_for_statements + +module For_proc_division = + Cobol_ast.Raw_visitor.Make_for_proc_division (PTree.Statements) + +module For_compilation_group = + Cobol_ast.Raw_visitor.Make_for_compilation_group + (PTree.Misc_sections) (PTree.Data_division) (PTree.Proc_division) + +include For_picture +include For_data_sections +include For_data_division +include For_statements +include For_proc_division +include For_compilation_group + +class ['a] folder = object (v) + inherit ['a] For_misc_sections.folder + inherit ['a] For_picture.folder + inherit! ['a] For_data_sections.folder + inherit! ['a] For_data_division.folder + inherit! ['a] For_statements.folder + inherit! ['a] For_proc_division.folder + inherit! ['a] For_compilation_group.folder + method private continue_with_informational_paragraphs = + For_misc_sections.fold_informational_paragraphs v + method private continue_with_options_paragraph = + For_misc_sections.fold_options_paragraph v + method private continue_with_environment_division = + For_misc_sections.fold_environment_division v + method private continue_with_picture = + For_picture.fold_picture v + method private continue_with_working_storage_section = + For_data_sections.fold_working_storage_section v + method private continue_with_screen_section = + For_data_sections.fold_screen_section v + method private continue_with_report_section = + For_data_sections.fold_report_section v + method private continue_with_local_storage_section = + For_data_sections.fold_local_storage_section v + method private continue_with_linkage_section = + For_data_sections.fold_linkage_section v + method private continue_with_file_section = + For_data_sections.fold_file_section v + method private continue_with_communication_section = + For_data_sections.fold_communication_section v + method private continue_with_data_division = + For_data_division.fold_data_division v + method private continue_with_statement' = + For_statements.fold_statement' v + method private continue_with_statements' = + For_statements.fold_statements' v + method private continue_with_procedure_division = + For_proc_division.fold_procedure_division v +end diff --git a/src/lsp/cobol_parser/package.toml b/src/lsp/cobol_parser/package.toml new file mode 100644 index 000000000..6dbf0227c --- /dev/null +++ b/src/lsp/cobol_parser/package.toml @@ -0,0 +1,151 @@ + +# name of package +name = "cobol_parser" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +generators = ["ocamllex"] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show" + +# files to skip while updating at package level +skip = ["main.ml", "index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_ast = "version" +cobol_common = "version" +cobol_preproc = "version" +ebcdic_lib = "version" +ez_file = ">=0.3" +ppx_deriving = ">=5.2.1" +[dependencies.menhir] +libname = "menhirLib" +version = ">=1.2" + +# package tools dependencies +[tools] +menhir = "=20220210" + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +dune-libraries = "str" +dune-trailer = """ +(menhir (modules grammar_tokens grammar_common grammar) + (merge_into grammar) + (flags --inspection --cmly --table --strict + + --external-tokens Grammar_tokens + --unused-tokens)) + + +(menhir (modules grammar_tokens) + (flags --inspection --table --only-tokens)) + +(rule + (targets text_keywords.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./keywords/gen_keywords.exe} %{deps} + --external-tokens Grammar_tokens)))) + +(rule + (targets grammar_post_actions.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./post/gen_post_actions.exe} %{deps})))) + +(rule + (targets grammar_recover.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./recover/gen_recover.exe} %{deps})))) + +(rule + (targets grammar_contexts.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./context/gen_contexts.exe} %{deps} + --external-tokens Grammar_tokens)))) + +(rule + (targets grammar_context.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./context/gen_context.exe} %{deps})))) + +(rule + (targets grammar_printer.ml) + (enabled_if (<> %{profile} "release")) + (deps grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:./printer/gen_printer.exe} %{deps})))) +""" +menhir-flags = "--table --strict" diff --git a/src/lsp/cobol_parser/parser_engine.ml b/src/lsp/cobol_parser/parser_engine.ml new file mode 100644 index 000000000..cdb520734 --- /dev/null +++ b/src/lsp/cobol_parser/parser_engine.ml @@ -0,0 +1,505 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module DIAGS = Cobol_common.Diagnostics + +open Cobol_common.Types +open Cobol_common.Srcloc.INFIX +include Parser_options (* import types for options *) + +module Make (Config: Cobol_config.T) = struct + + module Tokzr = Text_tokenizer.Make (Config) + module Overlay_manager = Grammar_utils.Overlay_manager + module Grammar_interpr = Grammar.MenhirInterpreter + module Grammar_recovery = + Recovery.Make (Grammar_interpr) (struct + include Grammar_recover + include Grammar_printer + let benign_assumption: Grammar_tokens.token -> bool = function + | PERIOD -> true + | _ -> false + end) + + module Post = Grammar_post_actions.Make (Config) + + (** State of the parser. + + In ['m state], the ['m] parameter denotes the ability of the parser to + memorize and provide every token that has been parsed so far, along with a + log of operations performed by the pre-processor. An + {!Cobol_common.Behaviors.amnesic} parser does not provide this ability, + contrary to an {!Cobol_common.Behaviors.eidetic} parser. This is + reflected in the final result (see {!parsed_result}), as {!parsed_tokens} + and {!preproc_rev_log} may only be called on results of eidetic + parsers. *) + type 'm state = + { + prev_limit: Cobol_preproc.Src_overlay.limit option; (* last right-limit *) + (* `prev_limit'` is required to deal with the single-step backtracking + upon recovery: *) + prev_limit': Cobol_preproc.Src_overlay.limit option; (* second-to-last *) + preproc: 'm preproc; + } + and 'm preproc = + (** state that typically change on a sentence-by-sentence basis (mostly the + pre-processor and tokenizer's states) *) + { + tokzr: 'm Tokzr.state; + pp: Cobol_preproc.preprocessor; (* also holds diagnistics *) + persist: 'm persist; + } + and 'm persist = + (** state that change very rarely, if at all *) + { + context_stack: Context.stack; + recovery: recovery; + tokenizer_memory: 'm memory; + verbose: bool; + show_if_verbose: [`Tks | `Ctx] list; + show: [`Pending] list; + } + + (* TODO: reset/restore text lexer's state w.r.t reserved/alias and + context-stack will be needed when we want a persistent parser state. Best + place for this is probaly in the tokenizer.*) + + let init_parser + ?(verbose = false) + ?(show_if_verbose = [`Tks; `Ctx]) + ?(show = [`Pending]) + (type m) ~(tokenizer_memory: m memory) + ~(recovery: recovery) + pp = + let tokzr: m Tokzr.state = + let memory: m Tokzr.memory = match tokenizer_memory with + | Parser_options.Amnesic -> Tokzr.amnesic + | Parser_options.Eidetic -> Tokzr.eidetic + in + Tokzr.init memory + ~context_sensitive_tokens:Grammar_contexts.sensitive_tokens + in + { + prev_limit = None; + prev_limit' = None; + preproc = + { + pp; + tokzr; + persist = + { + context_stack = Context.empty_stack; + recovery; + tokenizer_memory; + verbose; + show_if_verbose; + show; + } + } + } + + (* Helpers to avoid unnecessary copies of parser state *) + let update_pp ps pp = + if pp == ps.preproc.pp then ps + else { ps with preproc = { ps.preproc with pp } } + and update_tokzr ps tokzr = + if tokzr == ps.preproc.tokzr then ps + else { ps with preproc = { ps.preproc with tokzr } } + + let show tag + { preproc = { persist = { verbose; show_if_verbose; _ }; _ }; _ } = + verbose && List.mem tag show_if_verbose + + let add_diag diag ({ preproc = { pp; _ }; _ } as ps) = + update_pp ps (Cobol_preproc.add_diag pp diag) + let add_diags diags ({ preproc = { pp; _ }; _ } as ps) = + update_pp ps (Cobol_preproc.add_diags pp diags) + + let all_diags { preproc = { pp; tokzr; _ }; _ } = + DIAGS.Set.union (Cobol_preproc.diags pp) @@ Tokzr.diagnostics tokzr + + let rec produce_tokens (ps: _ state as 's) : 's * Text_tokenizer.tokens = + let text, pp = Cobol_preproc.next_sentence ps.preproc.pp in + let { preproc = { pp; tokzr; _ }; _ } as ps = update_pp ps pp in + assert (text <> []); + (* Note: this is the source format in use at the end of the sentence. *) + let Plx (pl, _) = Cobol_preproc.srclexer pp in + let source_format = Cobol_preproc.Src_lexing.source_format pl in + match Tokzr.tokenize_text ~source_format tokzr text with + | Error `MissingInputs, tokzr -> + produce_tokens (update_tokzr ps tokzr) + | Error `ReachedEOF tokens, tokzr + | Ok tokens, tokzr -> + if show `Tks ps then + Pretty.error "Tks: %a@." Text_tokenizer.pp_tokens tokens; + update_tokzr ps tokzr, tokens + + let state_num env = Grammar_interpr.current_state_number env + + let update_context_stack ~stack_update ~tokenizer_update + ({ preproc; _ } as ps) tokens : Context.t list -> 's * 'a = + let { tokzr; persist; _ } = preproc in + function + | [] -> + ps, tokens + | contexts -> + let context_stack, tokens_set = + List.fold_left begin fun (context_stack, set) ctx -> + let context_stack, set' = stack_update context_stack ctx in + context_stack, Text_lexer.TokenHandles.union set set' + end (persist.context_stack, Text_lexer.TokenHandles.empty) contexts + in + + (* Update tokenizer state *) + let tokzr, tokens = tokenizer_update tokzr tokens tokens_set in + if show `Tks ps then + Pretty.error "Tks': %a@." Text_tokenizer.pp_tokens tokens; + + (if context_stack == persist.context_stack && tokzr == preproc.tokzr + then ps + else { ps with + preproc = { preproc with + tokzr; persist = { persist with context_stack }}}), + tokens + + (** Use recovery trace (assumptions on missing tokens) to generate syntax + hints and report on an invalid syntax error. *) + let report_syntax_hints_n_error ps + (assumed: Grammar_recovery.assumption list) + ~(report_invalid_syntax: DIAGS.severity -> (_ state as 's) -> 's) + ~recovery_options + = + (* Gather one hint per source position of recovery assumptions, and + determine global benignness *) + let hints, globally_benign = + let concat_reports r1 r2 = match r1, r2 with + | Some r, Some s -> Some (Pretty.delayed "%t@ %t" r s) + | r, None | None, r -> r + in + List.fold_left begin fun (reports, benign') assumption -> + let Grammar_recovery.{ show; pos; benign } = assumption in + let show, prev_reports = match reports with + | (report, prev_pos) :: tl when prev_pos == pos -> (* same position *) + concat_reports report show, tl + | tl -> + show, tl (* new position *) + in + (* Note: Consider not benign if nothing is to be reported (show = + None). *) + (show, pos) :: prev_reports, benign && benign' && show <> None + end ([], assumed <> []) assumed (* initially benign unless no + assumption was involved *) + in + (* Accumulate hints about missing tokens *) + let diags = + List.fold_left begin fun diags -> function + | None, _ -> (* nothing relevant to report *) + diags + | Some pp_assumed, raw_pos -> + let loc = Overlay_manager.join_limits (raw_pos, raw_pos) in + DIAGS.Acc.hint diags ~loc "Missing@ %t" pp_assumed + end Cobol_common.Diagnostics.Set.none (List.rev hints) + in + let ps = add_diags diags ps in + (* Generate a global error or warning if necessary *) + if globally_benign && recovery_options.silence_benign_recoveries + then ps + else if globally_benign + then report_invalid_syntax DIAGS.Warn ps + else report_invalid_syntax DIAGS.Error ps + + (* --- *) + + let do_parse: type m. m state -> _ -> _ * m state = + + let rec next_tokens ({ preproc = { tokzr; _ }; _ } as ps) tokens = + match Tokzr.next_token tokzr tokens with + | Some (tokzr, token, tokens) -> + update_tokzr ps tokzr, (token, tokens) + | None -> + let ps, tokens = produce_tokens ps in + next_tokens ps tokens + in + + let token_n_srcloc_limits ?prev_limit token = + let s, e = Overlay_manager.limits ~@token in + Option.iter (fun e -> Overlay_manager.link_limits e s) prev_limit; + ~&token, s, e + in + + let put_token_back ({ preproc; _ } as ps) token tokens = + let tokzr, tokens = Tokzr.put_token_back preproc.tokzr token tokens in + { ps with prev_limit = ps.prev_limit'; + preproc = { ps.preproc with tokzr } }, tokens + in + + let leaving_context ps prod = + match Context.top ps.preproc.persist.context_stack with + | None -> false (* first filter *) + | Some top_ctx -> + match Grammar_interpr.lhs prod with + | X T _ -> false + | X N nt -> match Grammar_context.nonterminal_context nt with + | Some ctx -> ctx == top_ctx + | _ -> false + in + + let pop_context ({ preproc = { tokzr; persist; _ }; _ } as ps) tokens = + let context_stack, tokens_set = Context.pop persist.context_stack in + if show `Ctx ps then + Pretty.error "Outgoing: %a@." Context.pp_context tokens_set; + let tokzr, tokens = Tokzr.disable_tokens tokzr tokens tokens_set in + { ps with + preproc = { ps.preproc with + tokzr; persist = { persist with context_stack }}}, + tokens + in + + let push_incoming_contexts ps tokens env = + + let push context_stack ctx = + if show `Ctx ps then + Pretty.error "Incoming: %a@." Context.pp_context ctx; + + (* Push the new context on top of the stack *) + let context_stack = Context.push ctx context_stack in + + (* ... and retrieve newly reserved tokens *) + context_stack, Context.top_tokens context_stack + in + + (* Retrieve and enable all incoming contexts *) + update_context_stack ps tokens + (Grammar_context.contexts_for_state_num (state_num env)) + ~stack_update:push + ~tokenizer_update:Tokzr.enable_tokens + + and pop_outgoing_context ps tokens prod = + if leaving_context ps prod + then pop_context ps tokens + else ps, tokens + in + + (** Traverses a path (sequence of parser states or productions) that starts + with the state that matches the current context stack, and applies the + induced changes to the context stack. *) + let seesaw_context_stack ps tokens = + List.fold_left begin fun (ps, tokens) -> function + | Grammar_recovery.Env e -> push_incoming_contexts ps tokens e + | Grammar_recovery.Prod p -> pop_outgoing_context ps tokens p + end (ps, tokens) + in + + let env_loc env = + match Grammar_interpr.top env with + | None -> None + | Some (Element (_, _, s, e)) -> Some (Overlay_manager.join_limits (s, e)) + in + + let pending ?(severity = DIAGS.Warn) descr ps env = + if List.mem `Pending ps.preproc.persist.show then + let diag = + DIAGS.One.diag severity "Ignored@ %a@ (implementation@ pending)" + Pretty.text descr ?loc:(env_loc env) + in + add_diag diag ps + else ps + in + + let post_production ({ preproc = { tokzr; _ }; _ } as ps) + token tokens prod env = + match Post.post_production prod env with + | Post_diagnostic action -> + let ps = match action ~loc:(env_loc env) with + | Ok ((), Some diag) | Error Some diag -> add_diag diag ps + | Ok ((), None) | Error None -> ps + in + ps, token, tokens + | Post_special_names DecimalPointIsComma -> + let tokzr, token, tokens = + Tokzr.decimal_point_is_comma tokzr token tokens in + if show `Tks ps then + Pretty.error "Tks': %a@." Text_tokenizer.pp_tokens tokens; + update_tokzr ps tokzr, token, tokens + | Post_pending descr -> + pending descr ps env, token, tokens + | Post_special_names _ + | NoPost -> + ps, token, tokens + in + + let rec normal ({ prev_limit; _ } as ps) tokens = function + | Grammar_interpr.InputNeeded env as c -> + let ps, (token, tokens) = next_tokens ps tokens in + let _t, _, e as tok = token_n_srcloc_limits ?prev_limit token in + let ps = { ps with prev_limit = Some e; prev_limit' = prev_limit } in + check ps token tokens env (Grammar_interpr.offer c tok) + | Shifting (_e1, e2, _) as c -> + let ps, tokens = push_incoming_contexts ps tokens e2 in + normal ps tokens @@ Grammar_interpr.resume c + | Accepted v -> + accept ps v + | AboutToReduce _ (* may only happen upon `check` (or empty language) *) + | Rejected | HandlingError _ -> + assert false (* should never happen *) + + and on_production ps token tokens prod = function + | Grammar_interpr.HandlingError env + | AboutToReduce (env, _) + | Shifting (_, env, _) -> + post_production ps token tokens prod env + | _ -> + ps, token, tokens + + and check ps token tokens env = function + | Grammar_interpr.HandlingError env -> + error ps token tokens env + | AboutToReduce (_, prod) when leaving_context ps prod -> + (* Reoffer token *) + let ps, tokens = put_token_back ps token tokens in + let ps, tokens = pop_context ps tokens in + normal ps tokens @@ Grammar_interpr.input_needed env + | AboutToReduce (_, prod) as c -> + (* NB: Here, we assume semantic actions do not raise any exception; + maybe that's a tad too optimistic; if they did we may need to + report that. *) + let c = Grammar_interpr.resume c in + let ps, token, tokens = on_production ps token tokens prod c in + check ps token tokens env c + | Shifting (_e1, e2, _) as c -> + let ps, tokens = push_incoming_contexts ps tokens e2 in + check ps token tokens env @@ Grammar_interpr.resume c + | c -> + normal ps tokens c + + and error ps token tokens env = + let report_invalid_syntax = + let loc_limits = Grammar_interpr.positions env in + let loc = Overlay_manager.join_limits loc_limits in + fun severity -> add_diag (DIAGS.One.diag severity ~loc "Invalid@ syntax") + in + match ps.preproc.persist.recovery with + | EnableRecovery recovery_options -> + (* The limits of the re-submitted token will be re-constructed in + `token_n_srcloc_limits`, so `prev_limit` needs to be re-adjusted to + the second-to-last right-limit. *) + let ps, tokens = put_token_back ps token tokens in + recover ps tokens (Grammar_recovery.generate env) + ~report_syntax_hints_n_error:(report_syntax_hints_n_error + ~report_invalid_syntax + ~recovery_options) + | DisableRecovery -> + None, report_invalid_syntax Error ps + + and recover ({ prev_limit; _ } as ps) tokens candidates + ~report_syntax_hints_n_error = + let ps, (token, tokens) = next_tokens ps tokens in + let _, _, e as tok = token_n_srcloc_limits ?prev_limit token in + let ps = { ps with prev_limit = Some e; prev_limit' = prev_limit } in + match Grammar_recovery.attempt candidates tok with + | `Fail when ~&token <> Grammar_tokens.EOF -> (* ignore one token *) + recover ps tokens candidates ~report_syntax_hints_n_error + | `Fail when Option.is_none candidates.final -> + None, report_syntax_hints_n_error ps [] (* unable to recover *) + | `Fail -> + let v, assumed = Option.get candidates.final in + accept (report_syntax_hints_n_error ps assumed) v + | `Accept (v, assumed) -> + accept (report_syntax_hints_n_error ps assumed) v + | `Ok (c, _, visited, assumed) -> + let ps, tokens = seesaw_context_stack ps tokens visited in + normal (report_syntax_hints_n_error ps assumed) tokens c + + and accept ps v = + Some v, ps + + in + fun ps c -> normal ps [] c + + let parse ?verbose ?show ~recovery + (type m) ~(memory: m memory) pp checkpoint + : ('a option, m) output * _ = + let ps = init_parser ?verbose ?show ~recovery + ~tokenizer_memory:memory pp in + let res, ps = + (* TODO: catch in a deeper context to grab parsed tokens *) + try do_parse ps checkpoint with e -> None, add_diag (DIAGS.of_exn e) ps + in + match memory with + | Amnesic -> + Only res, all_diags ps + | Eidetic -> + let tokens = Tokzr.parsed_tokens ps.preproc.tokzr + and rev_log = Cobol_preproc.rev_log ps.preproc.pp in + WithTokens (res, tokens, rev_log), all_diags ps + +end + +let default_recovery = + EnableRecovery { silence_benign_recoveries = false } + +(* TODO: accept a record instead of many labeled arguments? *) +type 'm parsing_function + = ?source_format:Cobol_config.source_format_spec + -> ?config:Cobol_config.t + -> ?recovery:recovery + -> ?verbose:bool + -> ?show:[`Pending] list + -> libpath:string list + -> Cobol_preproc.input + -> (PTree.compilation_group option, 'm) parsed_result + +let parse + (type m) + ~(memory: m memory) + ?(source_format = Cobol_config.Auto) + ?(config = Cobol_config.default) + ?(recovery = default_recovery) + ?verbose + ?show + ~libpath + : Cobol_preproc.input -> (PTree.compilation_group option, m) parsed_result = + let preprocessor = Cobol_preproc.preprocessor ?verbose in + fun input -> + let { result = output, parsed_diags; diags = other_diags } = + Cobol_common.with_stateful_diagnostics input + ~f:begin fun _init_diags input -> + let pp = preprocessor input @@ + `WithLibpath Cobol_preproc.{ init_libpath = libpath; + init_config = config; + init_source_format = source_format} + in + let module P = Make (val config) in + P.parse ?verbose ?show ~memory ~recovery pp @@ + Grammar.Incremental.compilation_group @@ + Cobol_preproc.position pp + end + in + { + parsed_input = input; + parsed_output = output; + parsed_diags = DIAGS.Set.union parsed_diags other_diags + } + +let parse_simple = parse ~memory:Amnesic +let parse_with_tokens = parse ~memory:Eidetic + +let parsed_tokens + : (_, Cobol_common.Behaviors.eidetic) parsed_result -> _ = function + | { parsed_output = WithTokens (_, parsed_token_memory, _); _ } -> + parsed_token_memory + +let preproc_rev_log + : (_, Cobol_common.Behaviors.eidetic) parsed_result -> _ = function + | { parsed_output = WithTokens (_, _, preproc_rev_log); _ } -> + preproc_rev_log diff --git a/src/lsp/cobol_parser/parser_engine.mli b/src/lsp/cobol_parser/parser_engine.mli new file mode 100644 index 000000000..a3c913f7f --- /dev/null +++ b/src/lsp/cobol_parser/parser_engine.mli @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +include module type of Parser_options + +type 'm parsing_function + = ?source_format:Cobol_config.source_format_spec + -> ?config:Cobol_config.t + -> ?recovery:recovery + -> ?verbose:bool + -> ?show:[`Pending] list + -> libpath:string list + -> Cobol_preproc.input + -> (PTree.compilation_group option, 'm) parsed_result + +val parse: memory: 'm Parser_options.memory -> 'm parsing_function +val parse_simple: Cobol_common.Behaviors.amnesic parsing_function +val parse_with_tokens: Cobol_common.Behaviors.eidetic parsing_function + +val parsed_tokens + : (_, Cobol_common.Behaviors.eidetic) parsed_result -> tokens_with_locs Lazy.t +val preproc_rev_log + : (_, Cobol_common.Behaviors.eidetic) parsed_result -> Cobol_preproc.rev_log diff --git a/src/lsp/cobol_parser/parser_options.ml b/src/lsp/cobol_parser/parser_options.ml new file mode 100644 index 000000000..f15be8e58 --- /dev/null +++ b/src/lsp/cobol_parser/parser_options.ml @@ -0,0 +1,45 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Gathers some types used to define options for the parser engine. *) +(* We are only defining types here so an MLI would only be redundant. *) + +open Cobol_common.Srcloc.TYPES + +(** Switch for the recovery mechanism *) +type recovery = + | DisableRecovery + | EnableRecovery of recovery_options +and recovery_options = + { + silence_benign_recoveries: bool; (** Whether to silence reports about some + missing tokens (e.g, periods). *) + } + +type 'a memory = + | Amnesic: Cobol_common.Behaviors.amnesic memory + | Eidetic: Cobol_common.Behaviors.eidetic memory + +type tokens_with_locs = Grammar_tokens.token with_loc list +type ('a, 'm) output = + | Only: 'a -> + ('a, Cobol_common.Behaviors.amnesic) output + | WithTokens: 'a * tokens_with_locs Lazy.t * Cobol_preproc.rev_log -> + ('a, Cobol_common.Behaviors.eidetic) output + +type ('a, 'm) parsed_result = + { + parsed_input: Cobol_preproc.input; + parsed_diags: Cobol_common.Diagnostics.Set.t; + parsed_output: ('a, 'm) output; + } diff --git a/src/lsp/cobol_parser/post/dune b/src/lsp/cobol_parser/post/dune new file mode 100644 index 000000000..055e6a6b5 --- /dev/null +++ b/src/lsp/cobol_parser/post/dune @@ -0,0 +1,3 @@ +(executable + (name gen_post_actions) + (libraries unix fmt str menhirSdk)) diff --git a/src/lsp/cobol_parser/post/gen_post_actions.ml b/src/lsp/cobol_parser/post/gen_post_actions.ml new file mode 100644 index 000000000..e7580c1d6 --- /dev/null +++ b/src/lsp/cobol_parser/post/gen_post_actions.ml @@ -0,0 +1,172 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let cmlyname = ref None + +let usage_msg = Fmt.str "%s [OPTIONS] file.cmly" Sys.argv.(0) +let anon str = match !cmlyname with + | None -> cmlyname := Some str + | Some _ -> raise @@ Arg.Bad "Only one anonymous argument may be given" + +let () = Arg.parse [] anon usage_msg + +let cmlyname = match !cmlyname with + | None | Some "" -> Fmt.epr "%s@." usage_msg; exit 1 + | Some s -> s + +(* --- *) + +let menhir = "MenhirInterpreter" + +include MenhirSdk.Cmly_read.Read (struct let filename = cmlyname end) + +(* --- *) + +let tidyup = + let spaces = Str.regexp "[ \t\n\r]+" in + Str.global_replace spaces " " + +(* --- *) + +module StrMap = Map.Make (Stdlib.String) + +type post_action_repr = + { + tag: string; + fun_type: string; + } + +let post_actions = + let post_action_types = + List.filter_map begin fun a -> + if Attribute.has_label "post.tag" a then + let payload = tidyup (Attribute.payload a) in + let first_space = String.index payload ' ' in + let typename = String.sub payload 0 first_space + and typespec = String.(sub payload (succ first_space) + (length payload - first_space - 1)) in + Some (typename, typespec) + else + None + end Grammar.attributes + in + List.to_seq post_action_types |> + Seq.map (fun (k, fun_type) -> "post." ^ k, { tag = "Post_" ^ k; fun_type }) |> + StrMap.of_seq + +let post_action attrs = + let open Attribute in + List.find_opt (fun a -> StrMap.mem (label a) post_actions) attrs |> + Option.map (fun a -> StrMap.find (label a) post_actions, + try payload a with Not_found -> "Fun.id") + +(* --- *) + +let pp_functor_parameters = + Fmt.(list (fmt "(%s)")) + +let pp_extension_module ppf pp_struct = + let all_parameters = + let parameters = + List.filter (Attribute.has_label "post.parameter") Grammar.attributes |> + List.map Attribute.payload + in + Grammar.parameters @ parameters + in + if all_parameters <> [] then + Fmt.pf ppf + "@\n@[<2>module@ Make@ %a =@]\ + @\n@[<2>struct@;%t@]\ + @\nend" + pp_functor_parameters all_parameters + pp_struct + else + pp_struct ppf + +let pp_grammar_open ppf = + let grammar_module = + String.capitalize_ascii (Filename.basename Grammar.basename) + and grammar_params = + List.map (fun p -> List.hd (String.split_on_char ':' p)) Grammar.parameters + in + if grammar_params = [] then + Fmt.pf ppf "@\n@[<2>open@ %s@]" grammar_module + else + Fmt.pf ppf "@\n@[<2>open@ %s.Make@ %a@]" grammar_module + pp_functor_parameters grammar_params; + Fmt.pf ppf "@\nopen MenhirInterpreter" + +let pp_header ppf = + List.iter begin fun a -> + if Attribute.has_label "header" a || + Attribute.has_label "post.header" a then + Fmt.pf ppf "@\n%s" (Attribute.payload a) + end Grammar.attributes + +let pp_post_type ppf = + Fmt.pf ppf "@[<2>type post_action ="; + StrMap.iter begin fun _ { tag; fun_type } -> + Fmt.pf ppf "@\n|@[<2> %s: (@[%a@]) -> post_action@]" tag Fmt.text fun_type + end post_actions; + Fmt.pf ppf "@\n| NoPost: post_action@]" + +let pp_production_posts ppf = + let last_item_attrs p = + let rhs = Production.rhs p in + try + let _, _, last_item_attrs = rhs.(Array.length rhs - 1) in + last_item_attrs + with Invalid_argument _ -> [] + in + Fmt.pf ppf + "@\n@[<2>let post_production_num\ + @\n: type k. int -> k env -> post_action = fun prod_num env ->\ + @\nmatch top env with\ + @\n| None -> NoPost\ + @\n@[<4>| Some (Element (state, value, _, _)) ->\ + @\nmatch incoming_symbol state, prod_num with"; + Production.iter begin fun p -> + let pp_post_action ppf ({ tag; _ }, func) = match tidyup func with + | "" -> Fmt.pf ppf "%s value" tag + | func -> Fmt.pf ppf "%s (@[<2>(%a)@ value@])" tag Fmt.text func + in + match post_action (last_item_attrs p), + post_action (Production.attributes p) with + | Some a, _ | _, Some a -> + Fmt.pf ppf "@\n|@[<4> N N_%a, %d ->@;%a@]" + Print.mangled_nonterminal (Production.lhs p) (Production.to_int p) + pp_post_action a + | None, None -> () + end; + Fmt.pf ppf + "@\n| _ -> NoPost@]@]\ + @\n\ + @\n@[<2>let post_production\ + @\n: type k. production -> k env -> post_action = fun p ->\ + @\npost_production_num (production_index p)@]" + +let emit ppf = + Fmt.pf ppf + "(* Caution: this file was automatically generated from %s; do not edit *)\ + @\n[@@@@@@warning \"-33\"] (* <- do not warn on unused opens *)\ + @\n[@@@@@@warning \"-27\"] (* <- do not warn on unused variabes *)\ + @\n" cmlyname; + Fmt.pf ppf "%a@\n" pp_extension_module begin fun ppf -> + Fmt.pf ppf "%t@\n" pp_grammar_open; + Fmt.pf ppf "%t@\n" pp_header; + Fmt.pf ppf "%t@\n" pp_post_type; + Fmt.pf ppf "%t@\n" pp_production_posts; + end + +let () = + emit Fmt.stdout diff --git a/src/lsp/cobol_parser/printer b/src/lsp/cobol_parser/printer new file mode 120000 index 000000000..7e19aacdb --- /dev/null +++ b/src/lsp/cobol_parser/printer @@ -0,0 +1 @@ +../../../import/merlin/src/ocaml/preprocess/printer \ No newline at end of file diff --git a/src/lsp/cobol_parser/recover b/src/lsp/cobol_parser/recover new file mode 120000 index 000000000..62aca2670 --- /dev/null +++ b/src/lsp/cobol_parser/recover @@ -0,0 +1 @@ +../../../import/merlin/src/ocaml/preprocess/recover \ No newline at end of file diff --git a/src/lsp/cobol_parser/recovery.ml b/src/lsp/cobol_parser/recovery.ml new file mode 100644 index 000000000..475db6293 --- /dev/null +++ b/src/lsp/cobol_parser/recovery.ml @@ -0,0 +1,199 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* Note that's heavily inspired from merlin's own code for recovery *) + +module Make + (Parser: MenhirLib.IncrementalEngine.EVERYTHING) + (Recovery: sig + val default_value: 'a Parser.symbol -> 'a + val token_of_terminal: 'a Parser.terminal -> 'a -> Parser.token + val depth: int array + + type action = + | Abort + | R of int + | S: 'a Parser.symbol -> action + | Sub of action list + and decision = + | Nothing + | One of action list + | Select of (int -> action list) + + val recover: int -> decision + + val print_symbol: Parser.xsymbol -> string + val print_token: Parser.token -> string + val benign_assumption: Parser.token -> bool + end) = +struct + + type 'a candidate = + { + env: 'a Parser.env; + visited: 'a operation list; + assumed: assumption list; + } + and 'a operation = + | Env of 'a Parser.env + | Prod of Parser.production + and assumption = + { + show: Pretty.delayed option; + pos: Lexing.position; + benign: bool; + } + type 'a candidates = + { + final: ('a * assumption list) option; + candidates: 'a candidate list; + } + + module T = struct + (* FIXME: this is a bit ugly. We should ask for the type to be exported + publicly by MenhirLib. *) + + [@@@ocaml.warning "-37"] + + type 'a checkpoint = + | InputNeeded of 'a Parser.env + | Shifting of 'a Parser.env * 'a Parser.env * bool + | AboutToReduce of 'a Parser.env * Parser.production + | HandlingError of 'a Parser.env + | Accepted of 'a + | Rejected + external inj : 'a checkpoint -> 'a Parser.checkpoint = "%identity" + end + + let feed_token token visited env = + let rec aux visited = function + | Parser.HandlingError _ | Rejected -> `Fail + | Accepted v -> `Accept v + | Shifting (e, _, _) as c -> aux (Env e :: visited) (Parser.resume c) + | AboutToReduce (_, p) as c -> aux (Prod p :: visited) (Parser.resume c) + | InputNeeded env as c -> `Recovered (c, env, visited) + in + aux visited (Parser.offer (T.inj (T.InputNeeded env)) token) + + let candidate env = { env; visited = []; assumed = [] } + + let attempt r token = + let rec aux = function + | [] -> `Fail + | x :: xs -> match feed_token token x.visited x.env with + | `Fail -> + aux xs + | `Recovered (c, e, visited) -> + `Ok (c, x.env, List.rev (Env e :: visited), List.rev x.assumed) + | `Accept v -> + match aux xs with + | `Fail -> `Accept (v, List.rev x.assumed) + | x -> x + in + aux r.candidates + + let decide env = + let rec nth_state env n = + if n = 0 + then match Parser.top env with + | None -> -1 (*allow giving up recovery on empty files*) + | Some (Parser.Element (state, _, _, _)) -> Parser.number state + else match Parser.pop env with + | None -> assert (n = 1); -1 + | Some env -> nth_state env (n - 1) + in + let st = nth_state env 0 in + match Recovery.recover st with + | Nothing -> [] + | One actions -> actions + | Select f -> f (nth_state env Recovery.depth.(st)) + + let generate (type a) (env: a Parser.env) = + let module E = struct + exception Result of (a * assumption list) + end in + let eval ~endp path : Recovery.action -> a Parser.env * _ * _ = + let rec aux ((env, visited, assumed) as path) = function + | Recovery.Abort -> + raise Not_found + | Sub actions -> + List.fold_left aux path actions + | R prod -> + let prod = Parser.find_production prod in + Parser.force_reduction prod env, + Prod prod :: visited, + assumed + | S (N _ as sym) -> + let env = + Parser.feed sym endp (Recovery.default_value sym) endp env + and show = match Recovery.print_symbol @@ X sym with + | "" -> None + | sym_str -> Some (Pretty.delayed "%s" sym_str) + in + (* Here, we assume that a symbol that shows as an empty string + denotes a non-terminal that may be empty and is therefore a + benign assumption. *) + let benign = show = None in + env, Env env :: visited, { show; pos = endp; benign } :: assumed + | S (T t as sym) -> + let v = Recovery.default_value sym in + let token = Recovery.token_of_terminal t v in + match feed_token (token, endp, endp) visited env with + | `Fail -> + assert false + | `Accept v -> + raise (E.Result (v, assumed)) + | `Recovered (_, env, visited) -> + let show = match Recovery.print_token token with + | "" -> None + | sym_str -> Some (Pretty.delayed "%s" sym_str) + and benign = Recovery.benign_assumption token in + env, visited, { show; pos = endp; benign } :: assumed + in + aux path + in + let rec aux acc ((env, _visited, _assumed) as path) = + match Parser.top env with + | None -> + None, acc + | Some (Element (_, _, _, endp)) -> + match + let actions = decide env in + List.fold_left begin fun (path, acc) action -> + let env, visited, assumed as path = eval ~endp path action in + path, { env; visited; assumed } :: acc + end (path, []) actions |> snd + with + | [] -> + None, acc + | ({ env; visited; assumed } :: _) as candidates -> + aux (candidates @ acc) (env, visited, assumed) + | exception Not_found -> + None, acc + | exception (E.Result v) -> + Some v, acc + in + aux [] (env, [], []) + + let generate env = + let final, candidates = generate env in + let candidates = + List.fold_left begin fun acc t -> + if not (Parser.env_has_default_reduction t.env) + then t :: acc + else acc + end [] candidates + in + { final; candidates = candidate env :: candidates } + +end diff --git a/src/lsp/cobol_parser/text_categorizer.mll b/src/lsp/cobol_parser/text_categorizer.mll new file mode 100644 index 000000000..9809b2ea1 --- /dev/null +++ b/src/lsp/cobol_parser/text_categorizer.mll @@ -0,0 +1,103 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +{ +type output = + | Digits of string + | Numeric of string * (char * string * string option) option + | Word of string + | Punctuation of string + | End + | Unexpected of char + +type alphanum_suffix = STR | EBCDIC +type alphanum_content = + | AStr of string * alphanum_suffix + | AEBCDIC of int + | AEnd of { wellformed: bool } + | AUnexpected of char * alphanum_suffix + +} + +let blank = [' ' '\009' '\r' ] +let blanks = (blank+ | '\t') +let digit = [ '0'-'9' ] +let sign = [ '+' '-' ] +let opers = sign | ['*' '/' '>' '<' '=' '&'] | "**" | "::" | ">=" | "<=" | "<>" +let punct = opers | ['.' ':' '(' ')'] + +let integer = (sign? digit+) +let exponent = (sign digit+) + +let identchar = [ 'a'-'z' 'A'-'Z' '0'-'9' '-' '_' ] (* + extended characters *) +let firstidentchar = [ 'a'-'z' 'A'-'Z' '0'-'9' ] +let lastidentchar = firstidentchar +let ident = (firstidentchar (identchar* lastidentchar)?) + +(* Text-word tokenizer (after text manipulation phase) *) +rule token = parse + + | blanks + { token lexbuf } + + | (digit+ as s) + { Digits s } + + | (sign digit+ as n) + { Numeric (n, None) } + + | (sign? digit* as n) (['.' ','] as sep) (digit+ as d) + { Numeric (n, Some (sep, d, None)) } + + | (sign? digit* as n) (['.' ','] as sep) (digit+ as d) 'E' (exponent as e) + { Numeric (n, Some (sep, d, Some e)) } + + | ident as s (* 31 characters max *) + { Word s } + + | (opers | punct) as s + { Punctuation s } + + | eof + { End } + + | (_ as c) + { Unexpected c } + +(* TODO: distinguish lexing entry based on quotation *) +and alphanum_string = parse + + | ['"' '''] (digit+ as num) + { AEBCDIC (int_of_string num) } + + | ((['"' '''] (_ # digit)? | [^ '"' '''])* as str) + { AStr (str, STR) } + + | eof + { AEnd { wellformed = true } } + +and symbolic_ebcdic = parse + + | ','? ' '* (digit+ as num) + { AEBCDIC (int_of_string num) } + + | ' '* ['"' '''] + { alphanum_string lexbuf } + + | (_ as c) + { AUnexpected (c, EBCDIC) } + + | eof + { AEnd { wellformed = false } } + +(* --- *) diff --git a/src/lsp/cobol_parser/text_keywords.ml b/src/lsp/cobol_parser/text_keywords.ml new file mode 100644 index 000000000..95a064e5d --- /dev/null +++ b/src/lsp/cobol_parser/text_keywords.ml @@ -0,0 +1,1102 @@ +(* Caution: this file was automatically generated from grammar.cmly; do not edit *) +[@@@warning "-33"] (* <- do not warn on unused opens *) + +let keywords = Grammar_tokens.[ + "ZERO-FILL", ZERO_FILL; + "ZERO", ZERO; + "ZEROES", ZERO; + "ZEROS", ZERO; + "YYYYMMDD", YYYYMMDD; + "YYYYDDD", YYYYDDD; + "Y", Y; + "XOR", XOR; + "XML-SCHEMA", XML_SCHEMA; + "XML-DECLARATION", XML_DECLARATION; + "XML", XML; + "X", X; + "WRITE-VERIFY", WRITE_VERIFY; + "WRITE-ONLY", WRITE_ONLY; + "WRITERS", WRITERS; + "WRITE", WRITE; + "WRAP", WRAP; + "WORKING-STORAGE", WORKING_STORAGE; + "WORDS", WORDS; + "WITH", WITH; + "WINDOW", WINDOW; + "WIDTH-IN-CELLS", WIDTH_IN_CELLS; + "WIDTH", WIDTH; + "WHEN", WHEN; + "WEB-BROWSER", WEB_BROWSER; + "WAIT", WAIT; + "VTOP", VTOP; + "VSCROLL-POS", VSCROLL_POS; + "VSCROLL-BAR", VSCROLL_BAR; + "VSCROLL", VSCROLL; + "VPADDING", VPADDING; + "VOLATILE", VOLATILE; + "VIRTUAL-WIDTH", VIRTUAL_WIDTH; + "VERY-HEAVY", VERY_HEAVY; + "VERTICAL", VERTICAL; + "VARYING", VARYING; + "VARIANT", VARIANT; + "VARIABLE", VARIABLE; + "VALUE-FORMAT", VALUE_FORMAT; + "VALUES", VALUES; + "VALUE", VALUE; + "VALIDATING", VALIDATING; + "VALIDATE-STATUS", VALIDATE_STATUS; + "VAL-STATUS", VALIDATE_STATUS; + "VALIDATE", VALIDATE; + "VALID", VALID; + "V", V; + "UTF-8", UTF_8; + "UTF-16", UTF_16; + "USING", USING; + "USE-TAB", USE_TAB; + "USE-RETURN", USE_RETURN; + "USE-ALT", USE_ALT; + "USER-DEFAULT", USER_DEFAULT; + "USER", USER; + "USE", USE; + "USAGE", USAGE; + "UPPER", UPPER; + "UPON", UPON; + "UPDATERS", UPDATERS; + "UPDATE", UPDATE; + "UP", UP; + "UNTIL", UNTIL; + "UNSTRING", UNSTRING; + "UNSORTED", UNSORTED; + "UNSIGNED-SHORT", UNSIGNED_SHORT; + "UNSIGNED-LONG", UNSIGNED_LONG; + "UNSIGNED-INT", UNSIGNED_INT; + "UNSIGNED", UNSIGNED; + "UNLOCK", UNLOCK; + "UNIVERSAL", UNIVERSAL; + "UNIT", UNIT; + "UNFRAMED", UNFRAMED; + "UNDERLINE", UNDERLINE; + "UNBOUNDED", UNBOUNDED; + "UCS-4", UCS_4; + "U", U; + "TYPEDEF", TYPEDEF; + "TYPE", TYPE; + "TRUNCATION", TRUNCATION; + "TRUE", TRUE; + "TREE-VIEW", TREE_VIEW; + "TRANSPARENT", TRANSPARENT; + "TRANSFORM", TRANSFORM; + "TRAILING-SIGN", TRAILING_SIGN; + "TRAILING-SHIFT", TRAILING_SHIFT; + "TRAILING", TRAILING; + "TRADITIONAL-FONT", TRADITIONAL_FONT; + "TRACK-LIMIT", TRACK_LIMIT; + "TRACK-AREA", TRACK_AREA; + "TRACKS", TRACKS; + "TRACK", TRACK; + "TOWARD-LESSER", TOWARD_LESSER; + "TOWARD-GREATER", TOWARD_GREATER; + "TOP-LEVEL", TOP_LEVEL; + "TOP", TOP; + "TO", TO; + "TITLE-POSITION", TITLE_POSITION; + "TITLE", TITLE; + "TIME-OUT", TIME_OUT; + "TIMES", TIMES; + "TIME", TIME; + "TILED-HEADINGS", TILED_HEADINGS; + "THUMB-POSITION", THUMB_POSITION; + "THROUGH", THROUGH; + "THRU", THROUGH; + "3-D", THREEDIMENSIONAL; + "THREADS", THREADS; + "THREAD", THREAD; + "THEN", THEN; + "THAN", THAN; + "TEXT", TEXT; + "TEST", TEST; + "TERMINATION-VALUE", TERMINATION_VALUE; + "TERMINATE", TERMINATE; + "TERMINAL-INFO", TERMINAL_INFO; + "TERMINAL", TERMINAL; + "TEMPORARY", TEMPORARY; + "TAPE", TAPE; + "TALLYING", TALLYING; + "TAB-TO-DELETE", TAB_TO_DELETE; + "TAB-TO-ADD", TAB_TO_ADD; + "TABLE", TABLE; + "TAB", TAB; + "SYSTEM-OFFSET", SYSTEM_OFFSET; + "SYSTEM-INFO", SYSTEM_INFO; + "SYSTEM-DEFAULT", SYSTEM_DEFAULT; + "SYNC", SYNCHRONIZED; + "SYNCHRONIZED", SYNCHRONIZED; + "SYMBOLIC", SYMBOLIC; + "SYMBOL", SYMBOL; + "SWITCH", SWITCH; + "SUPPRESS", SUPPRESS; + "SUPER", SUPER; + "SUM", SUM; + "SUB-QUEUE-3", SUB_QUEUE_3; + "SUB-QUEUE-2", SUB_QUEUE_2; + "SUB-QUEUE-1", SUB_QUEUE_1; + "SUBWINDOW", SUBWINDOW; + "SUBTRACT", SUBTRACT; + "STYLE", STYLE; + "STRUCTURE", STRUCTURE; + "STRONG", STRONG; + "STRING", STRING; + "STOP", STOP; + "STEP", STEP; + "STDCALL", STDCALL; + "STATUS-TEXT", STATUS_TEXT; + "STATUS-BAR", STATUS_BAR; + "STATUS", STATUS; + "STATIC-LIST", STATIC_LIST; + "STATIC", STATIC; + "STATEMENT", STATEMENT; + "START-Y", START_Y; + "START-X", START_X; + "START", START; + "STANDARD-DECIMAL", STANDARD_DECIMAL; + "STANDARD-BINARY", STANDARD_BINARY; + "STANDARD-2", STANDARD_2; + "STANDARD-1", STANDARD_1; + "STANDARD", STANDARD; + "STACK", STACK; + "SQUARE", SQUARE; + "SPINNER", SPINNER; + "SPECIAL-NAMES", SPECIAL_NAMES; + "SPACE-FILL", SPACE_FILL; + "SPACE", SPACE; + "SPACES", SPACE; + "SOURCE-COMPUTER", SOURCE_COMPUTER; + "SOURCES", SOURCES; + "SOURCE", SOURCE; + "SORT-ORDER", SORT_ORDER; + "SORT-MERGE", SORT_MERGE; + "SORT", SORT; + "SMALL-FONT", SMALL_FONT; + "SIZE", SIZE; + "SIGNED-SHORT", SIGNED_SHORT; + "SIGNED-LONG", SIGNED_LONG; + "SIGNED-INT", SIGNED_INT; + "SIGNED", SIGNED; + "SIGN", SIGN; + "SHOW-SEL-ALWAYS", SHOW_SEL_ALWAYS; + "SHOW-NONE", SHOW_NONE; + "SHOW-LINES", SHOW_LINES; + "SHORT-DATE", SHORT_DATE; + "SHORT", SHORT; + "SHARING", SHARING; + "SHADOW", SHADOW; + "SHADING", SHADING; + "SET", SET; + "SEQUENTIAL", SEQUENTIAL; + "SEQUENCE", SEQUENCE; + "SEPARATION", SEPARATION; + "SEPARATE", SEPARATE; + "SENTENCE", SENTENCE; + "SEND", SEND; + "SELF-ACT", SELF_ACT; + "SELF", SELF; + "SELECT-ALL", SELECT_ALL; + "SELECTION-TEXT", SELECTION_TEXT; + "SELECTION-INDEX", SELECTION_INDEX; + "SELECT", SELECT; + "SEGMENT-LIMIT", SEGMENT_LIMIT; + "SEGMENT", SEGMENT; + "SECURITY", SECURITY ""; + "SECURE", SECURE; + "SECTION", SECTION; + "SECONDS", SECONDS; + "SEARCH-TEXT", SEARCH_TEXT; + "SEARCH-OPTIONS", SEARCH_OPTIONS; + "SEARCH", SEARCH; + "SD", SD; + "SCROLL-BAR", SCROLL_BAR; + "SCROLL", SCROLL; + "SCREEN", SCREEN; + "SAVE-AS-NO-PROMPT", SAVE_AS_NO_PROMPT; + "SAVE-AS", SAVE_AS; + "SAME", SAME; + "S", S; + "RUN", RUN; + "ROW-PROTECTION", ROW_PROTECTION; + "ROW-HEADINGS", ROW_HEADINGS; + "ROW-FONT", ROW_FONT; + "ROW-DIVIDERS", ROW_DIVIDERS; + "ROW-COLOR-PATTERN", ROW_COLOR_PATTERN; + "ROW-COLOR", ROW_COLOR; + "ROUNDING", ROUNDING; + "ROUNDED", ROUNDED; + "ROLLBACK", ROLLBACK; + "RIMMED", RIMMED; + "RIGHT-JUSTIFY", RIGHT_JUSTIFY; + "RIGHT-ALIGN", RIGHT_ALIGN; + "RIGHT", RIGHT; + "RH", RH; + "RF", RF; + "REWRITE", REWRITE; + "REWIND", REWIND; + "REVERSE-VIDEO", REVERSE_VIDEO; + "REVERSED", REVERSED; + "REVERSE", REVERSE; + "RETURNING", RETURNING; + "RETURN", RETURN; + "RETRY", RETRY; + "RESUME", RESUME; + "RESET-TABS", RESET_TABS; + "RESET-LIST", RESET_LIST; + "RESET-GRID", RESET_GRID; + "RESET", RESET; + "RESERVE", RESERVE; + "RERUN", RERUN; + "REREAD", REREAD; + "REQUIRED", REQUIRED; + "REPOSITORY", REPOSITORY; + "REPORTS", REPORTS; + "REPORTING", REPORTING; + "REPORT", REPORT; + "REPLACING", REPLACING; + "REPLACE", REPLACE; + "REPEATED", REPEATED; + "REORG-CRITERIA", REORG_CRITERIA; + "RENAMES", RENAMES; + "REMOVAL", REMOVAL; + "REMARKS", REMARKS ""; + "REMAINDER", REMAINDER; + "RELEASE", RELEASE; + "RELATIVE", RELATIVE; + "RELATION", RELATION; + "REGION-COLOR", REGION_COLOR; + "REFRESH", REFRESH; + "REFERENCES", REFERENCES; + "REFERENCE", REFERENCE; + "REEL", REEL; + "REDEFINES", REDEFINES; + "RECURSIVE", RECURSIVE; + "RECORD-TO-DELETE", RECORD_TO_DELETE; + "RECORD-TO-ADD", RECORD_TO_ADD; + "RECORD-OVERFLOW", RECORD_OVERFLOW; + "RECORD-DATA", RECORD_DATA; + "RECORDS", RECORDS; + "RECORDING", RECORDING; + "RECORD", RECORD; + "RECEIVED", RECEIVED; + "RECEIVE", RECEIVE; + "READ-ONLY", READ_ONLY; + "READERS", READERS; + "READ", READ; + "RD", RD; + "RANDOM", RANDOM; + "RAISING", RAISING; + "RAISED", RAISED; + "RAISE", RAISE; + "RADIO-BUTTON", RADIO_BUTTON; + "QUOTE", QUOTE; + "QUOTES", QUOTE; + "QUEUE", QUEUE; + "QUERY-INDEX", QUERY_INDEX; + "PUSH-BUTTON", PUSH_BUTTON; + "PURGE", PURGE; + "PROTOTYPE", PROTOTYPE; + "PROTECTED", PROTECTED; + "PROPERTY", PROPERTY; + "PROPERTIES", PROPERTIES; + "PROMPT", PROMPT; + "PROHIBITED", PROHIBITED; + "PROGRESS", PROGRESS; + "PROGRAM-POINTER", PROGRAM_POINTER; + "PROGRAM-ID", PROGRAM_ID; + "PROGRAM", PROGRAM; + "PROCESSING", PROCESSING; + "PROCEED", PROCEED; + "PROCEDURE-POINTER", PROCEDURE_POINTER; + "PROCEDURES", PROCEDURES; + "PROCEDURE", PROCEDURE; + "PRIORITY", PRIORITY; + "PRINT-PREVIEW", PRINT_PREVIEW; + "PRINT-NO-PROMPT", PRINT_NO_PROMPT; + "PRINTING", PRINTING; + "PRINTER-1", PRINTER_1; + "PRINTER", PRINTER; + "PRINT", PRINT; + "PREVIOUS", PREVIOUS; + "PRESENT", PRESENT; + "PREFIXED", PREFIXED; + "POSITIVE", POSITIVE; + "POSITION-SHIFT", POSITION_SHIFT; + "POSITION", POSITION; + "POS", POS; + "POP-UP", POP_UP; + "POINTER", POINTER; + "PLUS", PLUS; + "PLACEMENT", PLACEMENT; + "PIXEL", PIXEL; + "PIC", PICTURE; + "PICTURE", PICTURE; + "PHYSICAL", PHYSICAL; + "PH", PH; + "PF", PF; + "PERMANENT", PERMANENT; + "PERFORM", PERFORM; + "PASSWORD", PASSWORD; + "PASCAL", PASCAL; + "PARSE", PARSE; + "PARENT", PARENT; + "PARAGRAPH", PARAGRAPH; + "PAGE-SETUP", PAGE_SETUP; + "PAGE-COUNTER", PAGE_COUNTER; + "PAGED", PAGED; + "PAGE", PAGE; + "PADDING", PADDING; + "PACKED-DECIMAL", PACKED_DECIMAL; + "OVERRIDE", OVERRIDE; + "OVERLINE", OVERLINE; + "OVERLAP-TOP", OVERLAP_TOP; + "OVERLAP-LEFT", OVERLAP_LEFT; + "OVERFLOW", OVERFLOW; + "OUTPUT", OUTPUT; + "OTHERS", OTHERS; + "OTHER", OTHER; + "ORGANIZATION", ORGANIZATION; + "ORDER", ORDER; + "OR", OR; + "OPTIONS", OPTIONS; + "OPTIONAL", OPTIONAL; + "OPEN", OPEN; + "ONLY", ONLY; + "ON", ON; + "OMITTED", OMITTED; + "OK-BUTTON", OK_BUTTON; + "OFF", OFF; + "OF", OF; + "OCCURS", OCCURS; + "OBJECT-REFERENCE", OBJECT_REFERENCE; + "OBJECT-COMPUTER", OBJECT_COMPUTER; + "OBJECT", OBJECT; + "NUM-ROWS", NUM_ROWS; + "NUM-COL-HEADINGS", NUM_COL_HEADINGS; + "NUMERIC-EDITED", NUMERIC_EDITED; + "NUMERIC", NUMERIC; + "NUMBERS", NUMBERS; + "NUMBER", NUMBER; + "NULLS", NULLS; + "NULL", NULL; + "NO-UPDOWN", NO_UPDOWN; + "NO-SEARCH", NO_SEARCH; + "NO-KEY-LETTER", NO_KEY_LETTER; + "NO-GROUP-TAB", NO_GROUP_TAB; + "NO-FOCUS", NO_FOCUS; + "NO-F4", NO_F4; + "NO-ECHO", NO_ECHO; + "NO-DIVIDERS", NO_DIVIDERS; + "NO-BOX", NO_BOX; + "NO-AUTO-DEFAULT", NO_AUTO_DEFAULT; + "NO-AUTOSEL", NO_AUTOSEL; + "NOTIFY-SELCHANGE", NOTIFY_SELCHANGE; + "NOTIFY-DBLCLICK", NOTIFY_DBLCLICK; + "NOTIFY-CHANGE", NOTIFY_CHANGE; + "NOTIFY", NOTIFY; + "NOTHING", NOTHING; + "NOTAB", NOTAB; + "NOT", NOT; + "NORMAL", NORMAL; + "NONNUMERIC", NONNUMERIC; + "NONE", NONE; + "NOMINAL", NOMINAL; + "NO", NO; + "NEXT-ITEM", NEXT_ITEM; + "NEXT", NEXT; + "NEW", NEW; + "NESTED", NESTED; + "NEGATIVE", NEGATIVE; + "NEAREST-TO-ZERO", NEAREST_TO_ZERO; + "NEAREST-TOWARD-ZERO", NEAREST_TOWARD_ZERO; + "NEAREST-EVEN", NEAREST_EVEN; + "NEAREST-AWAY-FROM-ZERO", NEAREST_AWAY_FROM_ZERO; + "NAVIGATE-URL", NAVIGATE_URL; + "NATIVE", NATIVE; + "NATIONAL-EDITED", NATIONAL_EDITED; + "NATIONAL", NATIONAL; + "NAT", NAT; + "NAMESPACE-PREFIX", NAMESPACE_PREFIX; + "NAMESPACE", NAMESPACE; + "NAMED", NAMED; + "NAME", NAME; + "MULTIPLY", MULTIPLY; + "MULTIPLE", MULTIPLE; + "MULTILINE", MULTILINE; + "MOVE", MOVE; + "MODULES", MODULES; + "MODIFY", MODIFY; + "MODE", MODE; + "MIN-VAL", MIN_VAL; + "MINUS", MINUS; + "MICROSECOND-TIME", MICROSECOND_TIME; + "METHOD-ID", METHOD_ID; + "METHOD", METHOD; + "MESSAGE-TAG", MESSAGE_TAG; + "MESSAGE", MESSAGE; + "MERGE", MERGE; + "MENU", MENU; + "MEMORY", MEMORY; + "MEDIUM-FONT", MEDIUM_FONT; + "MAX-VAL", MAX_VAL; + "MAX-TEXT", MAX_TEXT; + "MAX-PROGRESS", MAX_PROGRESS; + "MAX-LINES", MAX_LINES; + "MASTER-INDEX", MASTER_INDEX; + "MASS-UPDATE", MASS_UPDATE; + "MANUAL", MANUAL; + "MAGNETIC-TAPE", MAGNETIC_TAPE; + "LOW-VALUE", LOW_VALUE; + "LOW-VALUES", LOW_VALUE; + "LOW-COLOR", LOW_COLOR; + "LOWLIGHT", LOWLIGHT; + "LOWERED", LOWERED; + "LOWER", LOWER; + "LONG-DATE", LONG_DATE; + "LOCK-HOLDING", LOCK_HOLDING; + "LOCK", LOCK; + "LOCATION", LOCATION; + "LOCAL-STORAGE", LOCAL_STORAGE; + "LOCALE", LOCALE; + "LOC", LOC; + "LM-RESIZE", LM_RESIZE; + "LIST-BOX", LIST_BOX; + "LINKAGE", LINKAGE; + "LINE-SEQUENTIAL", LINE_SEQUENTIAL; + "LINE-COUNTER", LINE_COUNTER; + "LINES-AT-ROOT", LINES_AT_ROOT; + "LINES", LINES; + "LINE", LINE; + "LINAGE-COUNTER", LINAGE_COUNTER; + "LINAGE", LINAGE; + "LIMITS", LIMITS; + "LIMIT", LIMIT; + "LIKE", LIKE; + "LIBRARY", LIBRARY; + "LESS", LESS; + "LENGTH", LENGTH; + "LEFT-TEXT", LEFT_TEXT; + "LEFT-JUSTIFY", LEFT_JUSTIFY; + "LEFTLINE", LEFTLINE; + "LEFT", LEFT; + "LEAVE", LEAVE; + "LEADING-SHIFT", LEADING_SHIFT; + "LEADING", LEADING; + "LC_TIME", LC_TIME; + "LC_NUMERIC", LC_NUMERIC; + "LC_MONETARY", LC_MONETARY; + "LC_MESSAGES", LC_MESSAGES; + "LC_CTYPE", LC_CTYPE; + "LC_COLLATE", LC_COLLATE; + "LC_ALL", LC_ALL; + "LAYOUT-MANAGER", LAYOUT_MANAGER; + "LAYOUT-DATA", LAYOUT_DATA; + "LAST-ROW", LAST_ROW; + "LAST", LAST; + "LARGE-OFFSET", LARGE_OFFSET; + "LARGE-FONT", LARGE_FONT; + "LABEL-OFFSET", LABEL_OFFSET; + "LABEL", LABEL; + "KEYBOARD", KEYBOARD; + "KEY", KEY; + "KEPT", KEPT; + "JUST", JUSTIFIED; + "JUSTIFIED", JUSTIFIED; + "JSON", JSON; + "I-O-CONTROL", I_O_CONTROL; + "I-O", I_O; + "ITEM-VALUE", ITEM_VALUE; + "ITEM-TO-EMPTY", ITEM_TO_EMPTY; + "ITEM-TO-DELETE", ITEM_TO_DELETE; + "ITEM-TO-ADD", ITEM_TO_ADD; + "ITEM-TEXT", ITEM_TEXT; + "ITEM", ITEM; + "IS", IS; + "IN-ARITHMETIC-RANGE", IN_ARITHMETIC_RANGE; + "INVOKE", INVOKE; + "INVALID", INVALID; + "INTRINSIC", INTRINSIC; + "INTO", INTO; + "INTERMEDIATE", INTERMEDIATE; + "INTERFACE-ID", INTERFACE_ID; + "INTERFACE", INTERFACE; + "INSTALLATION", INSTALLATION ""; + "INSPECT", INSPECT; + "INSERT-ROWS", INSERT_ROWS; + "INSERTION-INDEX", INSERTION_INDEX; + "INQUIRE", INQUIRE; + "INPUT-OUTPUT", INPUT_OUTPUT; + "INPUT", INPUT; + "INITIATE", INITIATE; + "INITIALIZED", INITIALIZED; + "INITIALIZE", INITIALIZE; + "INITIAL", INITIAL; + "INHERITS", INHERITS; + "INDICATE", INDICATE; + "INDEXED", INDEXED; + "INDEX", INDEX; + "INDEPENDENT", INDEPENDENT; + "IN", IN; + "IMPLEMENTS", IMPLEMENTS; + "IGNORING", IGNORING; + "IGNORE", IGNORE; + "IF", IF; + "IDENTIFIED", IDENTIFIED; + "IDENTIFICATION", IDENTIFICATION; + "ID", ID; + "ICON", ICON; + "HSCROLL-POS", HSCROLL_POS; + "HSCROLL", HSCROLL; + "HOT-TRACK", HOT_TRACK; + "HIGH-VALUE", HIGH_VALUE; + "HIGH-VALUES", HIGH_VALUE; + "HIGH-ORDER-RIGHT", HIGH_ORDER_RIGHT; + "HIGH-ORDER-LEFT", HIGH_ORDER_LEFT; + "HIGH-COLOR", HIGH_COLOR; + "HIGHLIGHT", HIGHLIGHT; + "HIDDEN-DATA", HIDDEN_DATA; + "HEX", HEX; + "HEIGHT-IN-CELLS", HEIGHT_IN_CELLS; + "HEAVY", HEAVY; + "HEADING-FONT", HEADING_FONT; + "HEADING-DIVIDER-COLOR", HEADING_DIVIDER_COLOR; + "HEADING-COLOR", HEADING_COLOR; + "HEADING", HEADING; + "HAS-CHILDREN", HAS_CHILDREN; + "HANDLE", HANDLE; + "GROUP-VALUE", GROUP_VALUE; + "GROUP-USAGE", GROUP_USAGE; + "GROUP", GROUP; + "GRID", GRID; + "GREATER", GREATER; + "GRAPHICAL", GRAPHICAL; + "GO-SEARCH", GO_SEARCH; + "GO-HOME", GO_HOME; + "GO-FORWARD", GO_FORWARD; + "GO-BACK", GO_BACK; + "GOBACK", GOBACK; + "GO", GO; + "GLOBAL", GLOBAL; + "GIVING", GIVING; + "GET", GET; + "GENERATE", GENERATE; + "FUNCTION-POINTER", FUNCTION_POINTER; + "FUNCTION-ID", FUNCTION_ID; + "FUNCTION", FUNCTION; + "FULL-HEIGHT", FULL_HEIGHT; + "FULL", FULL; + "FROM", FROM; + "FREE", FREE; + "FRAMED", FRAMED; + "FRAME", FRAME; + "FORMAT", FORMAT; + "FOREVER", FOREVER; + "FOREGROUND-COLOR", FOREGROUND_COLOR; + "FOR", FOR; + "FOOTING", FOOTING; + "FONT", FONT; + "FLOAT-SHORT", FLOAT_SHORT; + "FLOAT-NOT-A-NUMBER-SIGNALING", FLOAT_NOT_A_NUMBER_SIGNALING; + "FLOAT-NOT-A-NUMBER-QUIET", FLOAT_NOT_A_NUMBER_QUIET; + "FLOAT-NOT-A-NUMBER", FLOAT_NOT_A_NUMBER; + "FLOAT-LONG", FLOAT_LONG; + "FLOAT-INFINITY", FLOAT_INFINITY; + "FLOAT-EXTENDED", FLOAT_EXTENDED; + "FLOAT-DECIMAL-34", FLOAT_DECIMAL_34; + "FLOAT-DECIMAL-16", FLOAT_DECIMAL_16; + "FLOAT-DECIMAL", FLOAT_DECIMAL; + "FLOAT-BINARY-64", FLOAT_BINARY_64; + "FLOAT-BINARY-32", FLOAT_BINARY_32; + "FLOAT-BINARY-128", FLOAT_BINARY_128; + "FLOAT-BINARY", FLOAT_BINARY; + "FLOATING", FLOATING; + "FLOAT", FLOAT; + "FLAT-BUTTONS", FLAT_BUTTONS; + "FLAT", FLAT; + "FIXED-WIDTH", FIXED_WIDTH; + "FIXED-FONT", FIXED_FONT; + "FIXED", FIXED; + "FIRST", FIRST; + "FINISH-REASON", FINISH_REASON; + "FINALLY", FINALLY; + "FINAL", FINAL; + "FILL-PERCENT", FILL_PERCENT; + "FILL-COLOR2", FILL_COLOR2; + "FILL-COLOR", FILL_COLOR; + "FILLER", FILLER; + "FILE-POS", FILE_POS; + "FILE-NAME", FILE_NAME; + "FILE-LIMITS", FILE_LIMITS; + "FILE-LIMIT", FILE_LIMIT; + "FILE-ID", FILE_ID; + "FILE-CONTROL", FILE_CONTROL; + "FILE", FILE; + "FH--KEYDEF", FH__KEYDEF; + "FH--FCD", FH__FCD; + "FD", FD; + "FARTHEST-FROM-ZERO", FARTHEST_FROM_ZERO; + "FALSE", FALSE; + "FACTORY", FACTORY; + "F", F; + "EXTERNAL-FORM", EXTERNAL_FORM; + "EXTERNAL", EXTERNAL; + "EXTERN", EXTERN; + "EXTENDED-SEARCH", EXTENDED_SEARCH; + "EXTEND", EXTEND; + "EXPANDS", EXPANDS; + "EXPAND", EXPAND; + "EXIT", EXIT; + "EXHIBIT", EXHIBIT; + "EXCLUSIVE-OR", EXCLUSIVE_OR; + "EXCLUSIVE", EXCLUSIVE; + "EXCEPTION-VALUE", EXCEPTION_VALUE; + "EXCEPTION-OBJECT", EXCEPTION_OBJECT; + "EXCEPTION", EXCEPTION; + "EXAMINE", EXAMINE; + "EVERY", EVERY; + "EVENT-LIST", EVENT_LIST; + "EVENT", EVENT; + "EVALUATE", EVALUATE; + "ESI", ESI; + "ESCAPE-BUTTON", ESCAPE_BUTTON; + "ESCAPE", ESCAPE; + "ERROR", ERROR; + "ERASE", ERASE; + "EQUAL", EQUAL; + "EOS", EOS; + "EOP", EOP; + "EOL", EOL; + "EO", EO; + "ENVIRONMENT-VALUE", ENVIRONMENT_VALUE; + "ENVIRONMENT-NAME", ENVIRONMENT_NAME; + "ENVIRONMENT", ENVIRONMENT; + "ENTRY-REASON", ENTRY_REASON; + "ENTRY-FIELD", ENTRY_FIELD; + "ENTRY-CONVENTION", ENTRY_CONVENTION; + "ENTRY", ENTRY; + "ENTER", ENTER; + "ENSURE-VISIBLE", ENSURE_VISIBLE; + "ENGRAVED", ENGRAVED; + "END-XML", END_XML; + "END-WRITE", END_WRITE; + "END-UNSTRING", END_UNSTRING; + "END-SUBTRACT", END_SUBTRACT; + "END-STRING", END_STRING; + "END-START", END_START; + "END-SEND", END_SEND; + "END-SEARCH", END_SEARCH; + "END-REWRITE", END_REWRITE; + "END-RETURN", END_RETURN; + "END-RECEIVE", END_RECEIVE; + "END-READ", END_READ; + "END-PERFORM", END_PERFORM; + "END-OF-PAGE", END_OF_PAGE; + "END-MULTIPLY", END_MULTIPLY; + "END-MODIFY", END_MODIFY; + "END-JSON", END_JSON; + "END-IF", END_IF; + "END-EVALUATE", END_EVALUATE; + "END-DIVIDE", END_DIVIDE; + "END-DISPLAY", END_DISPLAY; + "END-DELETE", END_DELETE; + "END-COMPUTE", END_COMPUTE; + "END-COLOR", END_COLOR; + "END-CHAIN", END_CHAIN; + "END-CALL", END_CALL; + "END-ADD", END_ADD; + "END-ACCEPT", END_ACCEPT; + "END", END; + "ENCRYPTION", ENCRYPTION; + "ENCODING", ENCODING; + "ENABLE", ENABLE; + "EMI", EMI; + "ELSE", ELSE; + "ELEMENT", ELEMENT; + "EGI", EGI; + "EDITING", EDITING; + "ECHO", ECHO; + "EC", EC; + "EBCDIC", EBCDIC; + "DYNAMIC", DYNAMIC; + "DUPLICATES", DUPLICATES; + "DROP-LIST", DROP_LIST; + "DROP-DOWN", DROP_DOWN; + "DRAG-COLOR", DRAG_COLOR; + "DOWN", DOWN; + "DOUBLE", DOUBLE; + "DOTTED", DOTTED; + "DOTDASH", DOTDASH; + "DIVISION", DIVISION; + "DIVIDER-COLOR", DIVIDER_COLOR; + "DIVIDERS", DIVIDERS; + "DIVIDE", DIVIDE; + "DISPLAY-FORMAT", DISPLAY_FORMAT; + "DISPLAY-COLUMNS", DISPLAY_COLUMNS; + "DISPLAY-1", DISPLAY_1; + "DISPLAY", DISPLAY; + "DISP", DISP; + "DISK", DISK; + "DISC", DISC; + "DISABLE", DISABLE; + "DE", DETAIL; + "DETAIL", DETAIL; + "DESTROY", DESTROY; + "DESTINATION", DESTINATION; + "DESCENDING", DESCENDING; + "DEPENDING", DEPENDING; + "DELIMITER", DELIMITER; + "DELIMITED", DELIMITED; + "DELETE", DELETE; + "DEFINITION", DEFINITION; + "DEFAULT-FONT", DEFAULT_FONT; + "DEFAULT-BUTTON", DEFAULT_BUTTON; + "DEFAULT", DEFAULT; + "DECLARATIVES", DECLARATIVES; + "DECIMAL-POINT", DECIMAL_POINT; + "DECIMAL-ENCODING", DECIMAL_ENCODING; + "DEBUGGING", DEBUGGING; + "DAY-OF-WEEK", DAY_OF_WEEK; + "DAY", DAY; + "DATE-WRITTEN", DATE_WRITTEN ""; + "DATE-MODIFIED", DATE_MODIFIED ""; + "DATE-ENTRY", DATE_ENTRY; + "DATE-COMPILED", DATE_COMPILED ""; + "DATE", DATE; + "DATA-TYPES", DATA_TYPES; + "DATA-POINTER", DATA_POINTER; + "DATA-COLUMNS", DATA_COLUMNS; + "DATA", DATA; + "DASHED", DASHED; + "CYL-OVERFLOW", CYL_OVERFLOW; + "CYL-INDEX", CYL_INDEX; + "CYCLE", CYCLE; + "CUSTOM-PRINT-TEMPLATE", CUSTOM_PRINT_TEMPLATE; + "CURSOR-Y", CURSOR_Y; + "CURSOR-X", CURSOR_X; + "CURSOR-ROW", CURSOR_ROW; + "CURSOR-FRAME-WIDTH", CURSOR_FRAME_WIDTH; + "CURSOR-COLOR", CURSOR_COLOR; + "CURSOR-COL", CURSOR_COL; + "CURSOR", CURSOR; + "CURRENT", CURRENT; + "CURRENCY", CURRENCY; + "CSIZE", CSIZE; + "CRT-UNDER", CRT_UNDER; + "CRT", CRT; + "COUNT", COUNT; + "CORR", CORRESPONDING; + "CORRESPONDING", CORRESPONDING; + "CORE-INDEX", CORE_INDEX; + "COPY-SELECTION", COPY_SELECTION; + "COPY", COPY; + "CONVERTING", CONVERTING; + "CONVERSION", CONVERSION; + "CONTROLS", CONTROLS; + "CONTROL", CONTROL; + "CONTINUE", CONTINUE; + "CONTENT", CONTENT; + "CONTAINS", CONTAINS; + "CONSTANT", CONSTANT; + "CONFIGURATION", CONFIGURATION; + "CONDITION", CONDITION; + "COMPUTATIONAL-X", COMP_X; + "COMP-X", COMP_X; + "COMPUTATIONAL-N", COMP_N; + "COMP-N", COMP_N; + "COMP-9", COMP_9; + "COMPUTATIONAL-6", COMP_6; + "COMP-6", COMP_6; + "COMPUTATIONAL-5", COMP_5; + "COMP-5", COMP_5; + "COMPUTATIONAL-4", COMP_4; + "COMP-4", COMP_4; + "COMPUTATIONAL-3", COMP_3; + "COMP-3", COMP_3; + "COMPUTATIONAL-2", COMP_2; + "COMP-2", COMP_2; + "COMP-15", COMP_15; + "COMP-10", COMP_10; + "COMPUTATIONAL-1", COMP_1; + "COMP-1", COMP_1; + "COMPUTATIONAL-0", COMP_0; + "COMP-0", COMP_0; + "COMPUTE", COMPUTE; + "COMPUTATIONAL", COMP; + "COMP", COMP; + "COMMUNICATION", COMMUNICATION; + "COMMON", COMMON; + "COMMIT", COMMIT; + "COMMAND-LINE", COMMAND_LINE; + "COMMA", COMMA; + "COMBO-BOX", COMBO_BOX; + "COLUMN-PROTECTION", COLUMN_PROTECTION; + "COLUMN-HEADINGS", COLUMN_HEADINGS; + "COLUMN-FONT", COLUMN_FONT; + "COLUMN-DIVIDERS", COLUMN_DIVIDERS; + "COLUMN-COLOR", COLUMN_COLOR; + "COLUMNS", COLUMNS; + "COLS", COLUMNS; + "COLUMN", COLUMN; + "COLORS", COLORS; + "COLOR", COLOR; + "COLLATING", COLLATING; + "COL", COL; + "CODE-SET", CODE_SET; + "CODE", CODE; + "COBOL", COBOL; + "CLOSE", CLOSE; + "CLOCK-UNITS", CLOCK_UNITS; + "CLINES", CLINES; + "CLINE", CLINE; + "CLEAR-SELECTION", CLEAR_SELECTION; + "CLASS-ID", CLASS_ID; + "CLASSIFICATION", CLASSIFICATION; + "CLASS", CLASS; + "CHECK-BOX", CHECK_BOX; + "CHARACTERS", CHARACTERS; + "CHARACTER", CHARACTER; + "CHANGED", CHANGED; + "CHAINING", CHAINING; + "CHAIN", CHAIN; + "CH", CH; + "CF", CF; + "CENTURY-DATE", CENTURY_DATE; + "CENTERED-HEADINGS", CENTERED_HEADINGS; + "CENTERED", CENTERED; + "CENTER", CENTER; + "CELL-PROTECTION", CELL_PROTECTION; + "CELL-FONT", CELL_FONT; + "CELL-DATA", CELL_DATA; + "CELL-COLOR", CELL_COLOR; + "CELL", CELL; + "CD", CD; + "CCOL", CCOL; + "CASSETTE", CASSETTE; + "CARD-READER", CARD_READER; + "CARD-PUNCH", CARD_PUNCH; + "CAPACITY", CAPACITY; + "CANCEL-BUTTON", CANCEL_BUTTON; + "CANCEL", CANCEL; + "CALL", CALL; + "CALENDAR-FONT", CALENDAR_FONT; + "C", C; + "B-XOR", B_XOR; + "B-SHIFT-RC", B_SHIFT_RC; + "B-SHIFT-R", B_SHIFT_R; + "B-SHIFT-LC", B_SHIFT_LC; + "B-SHIFT-L", B_SHIFT_L; + "B-OR", B_OR; + "B-NOT", B_NOT; + "B-AND", B_AND; + "BYTE-LENGTH", BYTE_LENGTH; + "BYTES", BYTES; + "BYTE", BYTE; + "BY", BY; + "BUTTONS", BUTTONS; + "BUSY", BUSY; + "BULK-ADDITION", BULK_ADDITION; + "BOXED", BOXED; + "BOX", BOX; + "BOTTOM", BOTTOM; + "BOOLEAN", BOOLEAN; + "BLOCK", BLOCK; + "BLINK", BLINK; + "BLANK", BLANK; + "BITMAP-WIDTH", BITMAP_WIDTH; + "BITMAP-TRANSPARENT-COLOR", BITMAP_TRANSPARENT_COLOR; + "BITMAP-TRAILING", BITMAP_TRAILING; + "BITMAP-TIMER", BITMAP_TIMER; + "BITMAP-START", BITMAP_START; + "BITMAP-NUMBER", BITMAP_NUMBER; + "BITMAP-HANDLE", BITMAP_HANDLE; + "BITMAP-END", BITMAP_END; + "BITMAP", BITMAP; + "BIT", BIT; + "BINARY-SHORT", BINARY_SHORT; + "BINARY-SEQUENTIAL", BINARY_SEQUENTIAL; + "BINARY-LONG", BINARY_LONG; + "BINARY-ENCODING", BINARY_ENCODING; + "BINARY-DOUBLE", BINARY_DOUBLE; + "BINARY-C-LONG", BINARY_C_LONG; + "BINARY-CHAR", BINARY_CHAR; + "BINARY", BINARY; + "BELL", BELL; + "BEFORE", BEFORE; + "BASED", BASED; + "BAR", BAR; + "BACKWARD", BACKWARD; + "BACKGROUND-STANDARD", BACKGROUND_STANDARD; + "BACKGROUND-LOW", BACKGROUND_LOW; + "BACKGROUND-HIGH", BACKGROUND_HIGH; + "BACKGROUND-COLOR", BACKGROUND_COLOR; + "AWAY-FROM-ZERO", AWAY_FROM_ZERO; + "AUTO-SPIN", AUTO_SPIN; + "AUTO-DECIMAL", AUTO_DECIMAL; + "AUTOMATIC", AUTOMATIC; + "AUTO", AUTO; + "AUTHOR", AUTHOR ""; + "ATTRIBUTES", ATTRIBUTES; + "ATTRIBUTE", ATTRIBUTE; + "AT", AT; + "ASSIGN", ASSIGN; + "ASCII", ASCII; + "ASCENDING", ASCENDING; + "AS", AS; + "ARITHMETIC", ARITHMETIC; + "ARGUMENT-VALUE", ARGUMENT_VALUE; + "ARGUMENT-NUMBER", ARGUMENT_NUMBER; + "AREAS", AREAS; + "AREA", AREA; + "ARE", ARE; + "APPLY", APPLY; + "ANYCASE", ANYCASE; + "ANY", ANY; + "ANUM", ANUM; + "AND", AND; + "ALTERNATE", ALTERNATE; + "ALTER", ALTER; + "ALSO", ALSO; + "ALPHANUMERIC-EDITED", ALPHANUMERIC_EDITED; + "ALPHANUMERIC", ALPHANUMERIC; + "ALPHABETIC-UPPER", ALPHABETIC_UPPER; + "ALPHABETIC-LOWER", ALPHABETIC_LOWER; + "ALPHABETIC", ALPHABETIC; + "ALPHABET", ALPHABET; + "ALLOWING", ALLOWING; + "ALLOCATE", ALLOCATE; + "ALL", ALL; + "ALIGNMENT", ALIGNMENT; + "ALIGNED", ALIGNED; + "AFTER", AFTER; + "ADVANCING", ADVANCING; + "ADJUSTABLE-COLUMNS", ADJUSTABLE_COLUMNS; + "ADDRESS", ADDRESS; + "ADD", ADD; + "ACTUAL", ACTUAL; + "ACTIVE-X", ACTIVE_X; + "ACTIVE-CLASS", ACTIVE_CLASS; + "ACTIVATING", ACTIVATING; + "ACTION", ACTION; + "ACCESS", ACCESS; + "ACCEPT", ACCEPT; + "ABSENT", ABSENT; +] + +let puncts = Grammar_tokens.[ + "/", SLASH; + ")", RPAR; + "+", PLUS_SIGN; + ".", PERIOD; + "<>", NE; + "<", LT; + "(", LPAR; + "<=", LE; + ">", GT; + ">=", GE; + "=", EQ; + "::", DOUBLE_COLON; + "**", DOUBLE_ASTERISK; + "-", DASH_SIGN; + ":", COLON; + "*", ASTERISK; + "&", AMPERSAND; +] + +let silenced_keywords = Grammar_tokens.[ + "VLR"(*, VLR*); + "VIRTUAL"(*, VIRTUAL*); + "VIA"(*, VIA*); + "UNSEQUAL"(*, UNSEQUAL*); + "UFF"(*, UFF*); + "TERMINAL-X"(*, TERMINAL_X*); + "TERMINAL-3"(*, TERMINAL_3*); + "TERMINAL-2"(*, TERMINAL_2*); + "TERMINAL-1"(*, TERMINAL_1*); + "TERMINAL-0"(*, TERMINAL_0*); + "TEMP"(*, TEMP*); + "SYSTEM"(*, SYSTEM*); + "SYSOUT-X"(*, SYSOUT_X*); + "SYSOUT-3"(*, SYSOUT_3*); + "SYSOUT-2"(*, SYSOUT_2*); + "SYSOUT-1"(*, SYSOUT_1*); + "SYSOUT-0"(*, SYSOUT_0*); + "SYSIN-X"(*, SYSIN_X*); + "SYSIN-3"(*, SYSIN_3*); + "SYSIN-2"(*, SYSIN_2*); + "SYSIN-1"(*, SYSIN_1*); + "SYSIN-0"(*, SYSIN_0*); + "SUB-SCHEMA"(*, SUB_SCHEMA*); + "STATION"(*, STATION*); + "SSF"(*, SSF*); + "SELECTION"(*, SELECTION*); + "SECONDARY"(*, SECONDARY*); + "SARF"(*, SARF*); + "RETENTION"(*, RETENTION*); + "QUEUED"(*, QUEUED*); + "PROCESS-AREA"(*, PROCESS_AREA*); + "PRIMARY"(*, PRIMARY*); + "OVERRIDING"(*, OVERRIDING*); + "OPERATIONAL"(*, OPERATIONAL*); + "OBJECT-PROGRAM"(*, OBJECT_PROGRAM*); + "LOCKS"(*, LOCKS*); + "LINES-PER-PAGE"(*, LINES_PER_PAGE*); + "KEY-LOCATION"(*, KEY_LOCATION*); + "KEYED"(*, KEYED*); + "INVOKING"(*, INVOKING*); + "INDEX-2"(*, INDEX_2*); + "INDEX-1"(*, INDEX_1*); + "IDS-II"(*, IDS_II*); + "GCOS"(*, GCOS*); + "FLR"(*, FLR*); + "FILES"(*, FILES*); + "ENDING"(*, ENDING*); + "DISPLAY-4"(*, DISPLAY_4*); + "DISPLAY-3"(*, DISPLAY_3*); + "DISPLAY-2"(*, DISPLAY_2*); + "DISCONNECT"(*, DISCONNECT*); + "DEBUG-SUB-3"(*, DEBUG_SUB_3*); + "DEBUG-SUB-2"(*, DEBUG_SUB_2*); + "DEBUG-SUB-1"(*, DEBUG_SUB_1*); + "DEBUG-NAME"(*, DEBUG_NAME*); + "DEBUG-LINE"(*, DEBUG_LINE*); + "DEBUG-ITEM"(*, DEBUG_ITEM*); + "DEBUG-CONTENTS"(*, DEBUG_CONTENTS*); + "CS-GENERAL"(*, CS_GENERAL*); + "CS-BASIC"(*, CS_BASIC*); + "CONSOLE-3"(*, CONSOLE_3*); + "CONSOLE-2"(*, CONSOLE_2*); + "CONSOLE-1"(*, CONSOLE_1*); + "CONSOLE-0"(*, CONSOLE_0*); + "CONNECT"(*, CONNECT*); + "COMP-7"(*, COMP_7*); + "COMP-14"(*, COMP_14*); + "COMP-13"(*, COMP_13*); + "COMP-12"(*, COMP_12*); + "COMP-11"(*, COMP_11*); + "COMPUTATIONAL-7"(*, COMPUTATIONAL_7*); + "COMPUTATIONAL-14"(*, COMPUTATIONAL_14*); + "COMPUTATIONAL-13"(*, COMPUTATIONAL_13*); + "COMPUTATIONAL-12"(*, COMPUTATIONAL_12*); + "COMPUTATIONAL-11"(*, COMPUTATIONAL_11*); + "COMPLEMENTARY"(*, COMPLEMENTARY*); + "COMPLE"(*, COMPLE*); + "CHECKPOINT-FILE"(*, CHECKPOINT_FILE*); + "CHECK"(*, CHECK*); + "CATALOGUE-NAME"(*, CATALOGUE_NAME*); + "CATALOGUED"(*, CATALOGUED*); + "B-EXOR"(*, B_EXOR*); + "BSN"(*, BSN*); + "BITS"(*, BITS*); + "BEGINNING"(*, BEGINNING*); + "BECOMES"(*, BECOMES*); + "ASA"(*, ASA*); + "ANSI"(*, ANSI*); + "ALTERING"(*, ALTERING*); + "ALIAS"(*, ALIAS*); +] + diff --git a/src/lsp/cobol_parser/text_keywords.mli b/src/lsp/cobol_parser/text_keywords.mli new file mode 100644 index 000000000..d6795ecd5 --- /dev/null +++ b/src/lsp/cobol_parser/text_keywords.mli @@ -0,0 +1,25 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* NOTE: the implementation of this module is automatically generated from the + token descriptions in `grammar_tokens.mly` by using the + `keywords/gen_keywords.ml` utility. *) + +(** Mapping from keywords to their respective tokens *) +val keywords: (string * Grammar_tokens.token) list + +(** Set of {e inhibited} keywords *) +val silenced_keywords: string list + +(** Mapping from punctuations to their respective tokens *) +val puncts: (string * Grammar_tokens.token) list diff --git a/src/lsp/cobol_parser/text_lexer.ml b/src/lsp/cobol_parser/text_lexer.ml new file mode 100644 index 000000000..ea985050f --- /dev/null +++ b/src/lsp/cobol_parser/text_lexer.ml @@ -0,0 +1,256 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX + +module DIAGS = Cobol_common.Diagnostics + +module TYPES = struct + + type lexing_options = + { + decimal_point_is_comma: bool; + } + + type optional_token = + { + token: Grammar_tokens.token; + mutable reserved: bool; + mutable enabled: bool; + } + and token_handle = optional_token + +end +include TYPES + +module TokenHandles = struct + include Set.Make + (struct + type t = token_handle + let compare t1 t2 = Stdlib.compare t1.token t2.token + end) + let mem_text_token token = + mem { token; enabled = false; reserved = false } +end + +(* --- *) + +let default_lexing_options = + { + decimal_point_is_comma = false; + } + +(* --- *) + +module Make (Words: module type of Text_keywords) = struct + + let token_of_punct = Hashtbl.create 15 + let punct_of_token = Hashtbl.create 15 + let token_of_keyword = Hashtbl.create 257 + let keyword_of_token = Hashtbl.create 257 + + (** Raises {!Not_found} if the token is neither a keyword nor a + punctuation. *) + let show_token t = + try Hashtbl.find keyword_of_token t with + | Not_found -> Hashtbl.find punct_of_token t + + let handle_of_keyword kwd = + Hashtbl.find token_of_keyword kwd + + let handle_of_token token = + Hashtbl.find token_of_keyword (Hashtbl.find keyword_of_token token) + + let token_of_handle h = h.token + + (** Never raises {!Not_found}. *) + let show_token_of_handle h = + show_token @@ token_of_handle h + + let reserve_token h = h.reserved <- true + let unreserve_token h = h.reserved <- false + let enable_token h = h.enabled <- true + let disable_token h = h.enabled <- false + + let __init_puncts = + List.iter begin fun (punct, token) -> + Hashtbl.add punct_of_token token punct; + Hashtbl.add token_of_punct punct token + end Words.puncts + + let __init_default_keywords = + List.iter begin fun (kwd, token) -> + Hashtbl.add keyword_of_token token kwd; + (* Every default token needs to be reserved explicitly *) + Hashtbl.add token_of_keyword kwd + { token; enabled = true; reserved = false } + end Words.keywords + + let reserve_insensitive_token kwd token_handle = + Hashtbl.add token_of_keyword kwd + { token_handle with enabled = true; reserved = true } + + let reserve_sensitive_alias kwd token_handle = + Hashtbl.add token_of_keyword kwd token_handle + + let silenced_keywords = + Cobol_common.Basics.Strings.of_list Words.silenced_keywords + + let reserve_words: Cobol_config.words_spec -> unit = + let on_token_handle_of kwd descr ~f = + try f @@ handle_of_keyword kwd with + | Not_found when Cobol_common.Basics.Strings.mem kwd silenced_keywords -> + () (* Ignore silently? Warn? *) + | Not_found -> + Pretty.error "@[Unable@ to@ %s@ keyword:@ %s@]@." descr kwd + in + List.iter begin fun (w, word_spec) -> match word_spec with + | Cobol_config.ReserveWord { preserve_context_sensitivity } -> + on_token_handle_of w "reserve" ~f:begin fun h -> + if preserve_context_sensitivity + then reserve_token h + else reserve_insensitive_token w h + end + | ReserveAlias { alias_for; preserve_context_sensitivity } -> + on_token_handle_of alias_for "alias" ~f:begin fun h -> + if preserve_context_sensitivity + then reserve_sensitive_alias w h + else reserve_insensitive_token w h + end + | NotReserved -> + on_token_handle_of w "unreserve" ~f:unreserve_token + end + + let enable_tokens tokens = + TokenHandles.iter enable_token tokens + + let disable_tokens tokens = + TokenHandles.iter disable_token tokens + + (* --- *) + + let token_of_keyword s = + match Hashtbl.find token_of_keyword s with + | { token; enabled = true; reserved = true } -> token + | _ -> raise Not_found + + exception MultiToks of + (Grammar_tokens.token * int) list (* with length, except for last *) + + let token = + let open Grammar_tokens in + let unexpected_decimal_sep w c d e = + let head = + if w = "" + then [] + else [(if w.[0] <> '-' then DIGITS w else SINTLIT w), String.length w] + and tail = [ + INTERVENING_ c, 1; + match e with + | None -> DIGITS d, 0 + | Some e -> FLOATLIT (w, c, d, e), 0 + ] in + raise @@ MultiToks (head @ tail) + in + fun ~options:{ decimal_point_is_comma } lexbuf : token -> + match Text_categorizer.token lexbuf with + | Digits "88" -> + EIGHTY_EIGHT + | Digits w -> + DIGITS w + | Numeric (w, None) -> + SINTLIT w + | Numeric (n, Some (sep, d, None)) + when sep = if decimal_point_is_comma then ',' else '.' -> + FIXEDLIT (n, sep, d) + | Numeric (n, Some (sep, d, Some e)) + when sep = if decimal_point_is_comma then ',' else '.' -> + FLOATLIT (n, sep, d, e) + | Word s -> + (try token_of_keyword s with Not_found -> WORD s) + | Punctuation s -> + Hashtbl.find token_of_punct s + | End -> + EOF + | Numeric (w, Some (c, d, e)) -> + unexpected_decimal_sep w c d e + | Unexpected c -> (* likely to be a comma; will produce syntax errors + otherwise *) + INTERVENING_ c + + let token_of_string' ~options + : string with_loc -> Grammar_tokens.token with_loc = + fun t -> token ~options (Lexing.from_string ~&t) &@<- t + + let tokens ~options + : Lexing.lexbuf with_loc -> Grammar_tokens.token with_loc list = fun t -> + try [ token ~options ~&t &@<- t ] + with MultiToks toks -> + let rec aux acc loc = function + | [] -> acc + | [t, _] -> (t &@ loc) :: acc + | (t, len) :: (_ :: _ as tl) -> + let tloc = Cobol_common.Srcloc.prefix len loc + and loc = Cobol_common.Srcloc.trunc_prefix len loc in + aux ((t &@ tloc) :: acc) loc tl + in + List.rev @@ aux [] ~@t toks + + let tokens_of_string' ~options + : string with_loc -> Grammar_tokens.token with_loc list = + fun t -> tokens ~options ((Lexing.from_string ~&t) &@<- t) + + let ebcdic_char i = + (* TODO: (fixed/configurable tables) *) + String.make 1 (Char.chr @@ Ebcdic.to_ascii.(i)) + + let decode_symbolic_ebcdics' ~quotation w = + let open Text_categorizer in + let acc_error ?loc fmt = + DIAGS.kerror + (fun diag (acc, diags) -> acc, DIAGS.Set.cons diag diags) ?loc fmt + in + let symbolic_ebcdic ~loc:_ = symbolic_ebcdic + and alphanum_string ~loc:_ = alphanum_string in + let str, diags = + Cobol_common.Tokenizing.fold_tokens w ("", DIAGS.Set.none) + ~tokenizer:alphanum_string + ~until:(function AEnd _ -> true | _ -> false) + ~next_tokenizer:(function + | AEBCDIC _ + | AStr (_, EBCDIC) | AUnexpected (_, EBCDIC) -> symbolic_ebcdic + | AStr (_, STR) | AUnexpected (_, STR) | AEnd _ -> alphanum_string) + ~f:begin fun t -> match ~&t with (* TODO: (fixed/configurable tables) *) + | AStr (s, _) -> + fun (acc, diags) -> acc ^ s, diags + | AEBCDIC i when i < 1 || i > 256 -> + acc_error ~loc:~@t "Invalid@ symbolic@ character@ ordinal@ \ + (expected@ range@ is@ {1, ..., 256})" + | AEBCDIC i -> + fun (acc, diags) -> acc ^ ebcdic_char i, diags + | AEnd { wellformed = true } -> + Fun.id + | AEnd { wellformed = false } -> + acc_error ~loc:~@w "Malformed@ alphanumeric@ literal" + | AUnexpected (c, _) -> + acc_error ~loc:~@t "Unexpected@ character:@ `%c'" c + end + in + Grammar_tokens.ALPHANUM (str, quotation) &@<- w, diags + +end + +include Make (Text_keywords) + +(* --- *) diff --git a/src/lsp/cobol_parser/text_lexer.mli b/src/lsp/cobol_parser/text_lexer.mli new file mode 100644 index 000000000..fb36ebf3a --- /dev/null +++ b/src/lsp/cobol_parser/text_lexer.mli @@ -0,0 +1,90 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module TYPES: sig + type token_handle + type lexing_options = + { + decimal_point_is_comma: bool; + } +end +include module type of TYPES + +module TokenHandles: sig + include Set.S with type elt = token_handle + val mem_text_token: Grammar_tokens.token -> t -> bool +end + +val show_token: Grammar_tokens.token -> string +val show_token_of_handle: token_handle -> string + +(* --- *) + +val handle_of_token: Grammar_tokens.token -> token_handle +val reserve_words: Cobol_config.words_spec -> unit +val enable_tokens: TokenHandles.t -> unit +val disable_tokens: TokenHandles.t -> unit + +(** Only for debugging *) +val keyword_of_token : (Grammar_tokens.token, string) Hashtbl.t +val punct_of_token : (Grammar_tokens.token, string) Hashtbl.t + +(* --- *) + +val default_lexing_options: lexing_options + +(* --- *) + +exception MultiToks of + (Grammar_tokens.token * int) list (* with length, except for last *) + +(** [token ~options lexbuf] tokenizes a lexing buffer [lexbuf] into a simple + token; may raise {!MultiToks} is the contents of the buffer is tokenized + into more than one token. *) +val token + : options: lexing_options + -> Lexing.lexbuf + -> Grammar_tokens.token + +(** [token_of_string'] is similar to {!token}, except that it operates on a + localized string and returns a token with its location. May also raise + {!MultiToks}. *) +val token_of_string' + : options: lexing_options + -> string Cobol_common.Srcloc.with_loc + -> Grammar_tokens.token Cobol_common.Srcloc.with_loc + +(** [tokens ~options lexbuf'] tokenizes a lexing buffer with location [lexbuf'] + into a list of localized tokens. *) +val tokens + : options: lexing_options + -> Lexing.lexbuf Cobol_common.Srcloc.with_loc + -> Grammar_tokens.token Cobol_common.Srcloc.with_loc list + +(** [tokens_of_string'] is similar to {!token}, except that it operates on a + localized string. *) +val tokens_of_string' + : options: lexing_options + -> string Cobol_common.Srcloc.with_loc + -> Grammar_tokens.token Cobol_common.Srcloc.with_loc list + +(** [decode_symbolic_ebcdics' ~quotation s'] decodes the symbolic EBCDIC + characters from the localized string [s'], and returns the resulting + {!Grammar_tokens.ALPHANUM} token and a set of diagnostics. In case of + errors, the alphanumeric token returned may represent part of the encoded + input. *) +val decode_symbolic_ebcdics' + : quotation: Cobol_preproc.Text.quotation + -> string Cobol_common.Srcloc.with_loc + -> Grammar_tokens.token Cobol_common.Srcloc.with_loc * + Cobol_common.Diagnostics.Set.t diff --git a/src/lsp/cobol_parser/text_tokenizer.ml b/src/lsp/cobol_parser/text_tokenizer.ml new file mode 100644 index 000000000..06dd70ee9 --- /dev/null +++ b/src/lsp/cobol_parser/text_tokenizer.ml @@ -0,0 +1,511 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module TEXT = Cobol_preproc.Text +module DIAGS = Cobol_common.Diagnostics + +open Cobol_common.Srcloc.INFIX +open Cobol_common.Srcloc.TYPES +open Cobol_preproc.Text.TYPES +open Grammar_tokens (* import token constructors *) + +(* --- *) + +type token = Grammar_tokens.token with_loc +type tokens = token list + +let combined_tokens = + (* /!\ WARNING: None of the constituents of combined tokens may be + context-sensitive. + + Rationale: this would considerably complicate retokenization (which is + necessary with the current solution to handle context-sensitive + keywords) *) + Hashtbl.of_seq @@ List.to_seq [ + ON_EXCEPTION, "ON_EXCEPTION"; + NOT_ON_EXCEPTION, "NOT_ON_EXCEPTION"; + ON_OVERFLOW, "ON_OVERFLOW"; + NOT_ON_OVERFLOW, "NOT_ON_OVERFLOW"; + ON_SIZE_ERROR, "ON_SIZE_ERROR"; + NOT_ON_SIZE_ERROR, "NOT_ON_SIZE_ERROR"; + INVALID_KEY, "INVALID_KEY"; + NOT_INVALID_KEY, "NOT_INVALID_KEY"; + AT_END, "AT_END"; + NOT_AT_END, "NOT_AT_END"; + AT_EOP, "AT_EOP"; + NOT_AT_EOP, "NOT_AT_EOP"; + WITH_DATA, "WITH_DATA"; + NO_DATA, "NO_DATA"; + IS_GLOBAL, "IS_GLOBAL"; + IS_EXTERNAL, "IS_EXTERNAL"; + IS_TYPEDEF, "IS_TYPEDEF"; + DATA_RECORD, "DATA_RECORD"; + DATA_RECORDS, "DATA_RECORDS"; + NEXT_PAGE, "NEXT_PAGE"; + ] + +let pp_token: token Pretty.printer = fun ppf -> + let string s = Pretty.string ppf s + and print format = Pretty.print ppf format in + fun t -> match ~&t with + | WORD w -> print "WORD[%s]" w + | WORD_IN_AREA_A w -> print "WORD_IN_AREA_A[%s]" w + | PICTURE_STRING w -> print "PICTURE_STRING[%s]" w + | AUTHOR s -> print "AUTHOR[%s]" s + | DIGITS i -> print "DIGITS[%s]" i + | SINTLIT i -> print "SINT[%s]" i + | EIGHTY_EIGHT -> string "88" + | FIXEDLIT (i, sep, d) -> print "FIXED[%s%c%s]" i sep d + | FLOATLIT (i, sep, d, e) -> print "FLOAT[%s%c%sE%s]" i sep d e + | ALPHANUM (s, q) -> print "%a%s%a" TEXT.pp_quote q s TEXT.pp_quote q + | ALPHANUM_PREFIX (s, q) -> print "%a%s" TEXT.pp_quote q s + | NATLIT s -> print "N\"%s\"" s + | BOOLIT b -> print "B\"%a\"" Cobol_ast.pp_boolean b + | HEXLIT s -> print "X\"%s\"" s + | NULLIT s -> print "Z\"%s\"" s + | INTERVENING_ c -> print "<%c>" c + | EOF -> string "EOF" + | t -> string @@ + try Text_lexer.show_token t + with Not_found -> + try Hashtbl.find combined_tokens t + with Not_found -> "" + +let pp_tokens = Pretty.list ~fopen:"@[" ~fclose:"@]" pp_token + +(* --- *) + +let loc_in_area_a: srcloc -> bool = Cobol_common.Srcloc.in_area_a +let token_in_area_a: token -> bool = fun t -> loc_in_area_a ~@t + +(* --- *) + +(* Tokenization of manipulated text, to feed the compilation group parser: *) + +let preproc_n_combine_tokens (module Config: Cobol_config.T) ~source_format = + (* Simplifies the grammar. *) + let ( +@+ ) = Cobol_common.Srcloc.concat + and start_pos = Cobol_common.Srcloc.start_pos + and comment_entry_termination + = Cobol_preproc.Src_lexing.comment_entry_termination source_format in + let open List in + let rec skip ((p', l', dgs) as acc) ((p, l) as pl) = function + | 0 -> acc, pl + | i -> skip (hd p :: p', hd l :: l', dgs) (tl p, tl l) (i - 1) + and aux acc (p, l) = + let subst_n x y = + let rec cons x ((p', l', dgs) as _acc) (p, l) = function + | 0 -> assert false + | 1 -> aux (x :: p', hd l :: l', dgs) (tl p, tl l) + | i -> cons x acc (tl p, hd l +@+ hd (tl l) :: tl (tl l)) (i - 1) + in + cons x acc (p, l) y + and word_after n = + let word = function + | WORD _ as t -> t + | t -> try WORD (Hashtbl.find Text_lexer.keyword_of_token t) with + | Not_found -> t + in + let (p', l', dgs), (p, l) = skip acc (p, l) n in + match p with + | [] -> Result.Error `MissingInputs + | t :: _ -> aux (word t :: p', hd l :: l', dgs) (tl p, tl l) (* XXX: +@+ ? *) + and lex_err msg = + Pretty.delayed_to begin fun dmsg -> + let (p', l', diags), pl = skip acc (p, l) 1 in + aux (p', l', DIAGS.Acc.error diags ~loc:(hd l) "%t" dmsg) pl + end msg + and comment_paragraph t = + let subst_comment_entry = match comment_entry_termination with + | Newline -> + subst_comment_line ~init_pos:(Cobol_common.Srcloc.start_pos @@ hd l) + | Period -> + subst_comment_entry ?stop_column:None + | AreaB { first_area_b_column } -> + subst_comment_entry ~stop_column:first_area_b_column + and at_end ~loc ((p', l', diags) as acc) = + match Config.comment_paragraphs#verify ~loc:(Some loc) with + | Ok ((), None) | Error None -> acc + | Ok ((), Some d) | Error (Some d) -> p', l', DIAGS.Set.cons d diags + in + subst_comment_entry ~loc:(hd l) ~at_end + ("comment@ paragraph": Pretty.simple) t acc (tl (tl p), tl (tl l)) + in + match p with + + | [ON] | [NOT] | [NOT; ON] -> Error `MissingInputs + | ON :: EXCEPTION :: _ -> subst_n ON_EXCEPTION 2 + | NOT :: EXCEPTION :: _ -> subst_n NOT_ON_EXCEPTION 2 + | NOT :: ON :: EXCEPTION :: _ -> subst_n NOT_ON_EXCEPTION 3 + + | ON :: OVERFLOW :: _ -> subst_n ON_OVERFLOW 2 + | NOT :: OVERFLOW :: _ -> subst_n NOT_ON_OVERFLOW 2 + | NOT :: ON :: OVERFLOW :: _ -> subst_n NOT_ON_OVERFLOW 3 + + | [ON; SIZE] | [SIZE] + | [NOT; ON; SIZE] | [NOT; SIZE] -> Error `MissingInputs + | ON :: SIZE :: ERROR :: _ -> subst_n ON_SIZE_ERROR 3 + | SIZE :: ERROR :: _ -> subst_n ON_SIZE_ERROR 2 + | NOT :: ON :: SIZE :: ERROR :: _ -> subst_n NOT_ON_SIZE_ERROR 4 + | NOT :: SIZE :: ERROR :: _ -> subst_n NOT_ON_SIZE_ERROR 3 + + | [INVALID] | [NOT; INVALID] -> Error `MissingInputs + | INVALID :: KEY :: _ -> subst_n INVALID_KEY 2 + | INVALID :: _ -> subst_n INVALID_KEY 1 + | NOT :: INVALID :: KEY :: _ -> subst_n NOT_INVALID_KEY 3 + | NOT :: INVALID :: _ -> subst_n NOT_INVALID_KEY 2 + + | [AT] | [NOT; AT] -> Error `MissingInputs + | AT :: END :: _ -> subst_n AT_END 2 + | NOT :: AT :: END :: _ -> subst_n NOT_AT_END 3 + | NOT :: END :: _ -> subst_n NOT_AT_END 2 + + | AT ::(END_OF_PAGE|EOP):: _ -> subst_n AT_EOP 2 + | NOT :: AT ::(END_OF_PAGE|EOP):: _ -> subst_n NOT_AT_EOP 3 + | NOT ::(END_OF_PAGE|EOP):: _ -> subst_n NOT_AT_EOP 2 + + | [WITH] | [NO] -> Error `MissingInputs + | WITH :: DATA :: _ -> subst_n WITH_DATA 2 + | NO :: DATA :: _ -> subst_n NO_DATA 2 + + | [IS] -> Error `MissingInputs + | IS :: GLOBAL :: _ -> subst_n IS_GLOBAL 2 + | IS :: EXTERNAL :: _ -> subst_n IS_EXTERNAL 2 + | IS :: TYPEDEF :: _ -> subst_n IS_TYPEDEF 2 + + | [DATA] -> Error `MissingInputs + | DATA :: RECORD :: _ -> subst_n DATA_RECORD 2 + | DATA :: RECORDS :: _ -> subst_n DATA_RECORDS 2 + + | [NEXT] -> Error `MissingInputs + | NEXT :: PAGE :: _ -> subst_n NEXT_PAGE 2 + + | PROGRAM_ID :: PERIOD :: _ -> word_after 2 + + | (AUTHOR _ | + INSTALLATION _ | + DATE_WRITTEN _ | + DATE_MODIFIED _ | + DATE_COMPILED _ | + REMARKS _ | + SECURITY _) as t :: PERIOD :: _ -> comment_paragraph t + + | ALPHANUM_PREFIX (s, _) :: _ -> lex_err "Missing continuation of `%s'" s + + | tok :: _ -> subst_n tok 1 + + | [] -> Ok acc + and subst_comment_entry ?stop_column ~loc ~at_end descr x acc = function + | [], _ -> + Result.Error `MissingInputs (* no word starting in Area A, or not period yet *) + | EOF :: _ as p, l -> + let _, _, diags = at_end ~loc acc in (* ignore all tokens until EOF *) + Error (`ReachedEOF (loc, descr, diags, p, l)) + | PERIOD :: p, period_loc :: l + when Option.is_none stop_column -> + aux (at_end ~loc:(loc +@+ period_loc) acc) (p, l) + | p, (p_loc :: _ as l) + when (let Lexing.{ pos_bol; pos_cnum; _ } = start_pos p_loc in + Option.fold stop_column + ~some:(fun col -> pos_cnum - pos_bol < col) ~none:false) -> + aux (at_end ~loc acc) (p, l) + | _ :: tlp, l -> + subst_comment_entry ?stop_column ~loc:(loc +@+ hd l) ~at_end + descr x acc (tlp, tl l) + and subst_comment_line ~init_pos ~loc ~at_end descr x acc = function + | [], _ -> + Result.Error `MissingInputs (* found no word starting on anther line *) + | p, (p_loc :: _ as l) + when (let Lexing.{ pos_fname; pos_bol; _ } = start_pos p_loc in + pos_bol > init_pos.Lexing.pos_bol || + pos_fname <> init_pos.pos_fname) -> + aux (at_end ~loc acc) (p, l) + | _ :: tlp, l -> + subst_comment_line ~init_pos ~loc:(loc +@+ hd l) ~at_end + descr x acc (tlp, tl l) + in + fun tokens -> + let p, srclocs = split @@ map (~&@) tokens in + match aux ([], [], DIAGS.Set.none) (p, srclocs) with + | Ok (p, l, dgs) -> + Ok (rev_map2 (&@) p l, dgs) + | Error (`ReachedEOF (loc, descr, dgs, p, l)) -> + Error (`ReachedEOF (loc, descr, dgs, rev_map2 (&@) p l)) + | Error `MissingInputs -> + Error `MissingInputs + +(* --- *) + +module Make (Config: Cobol_config.T) = struct + + let init_text_lexer ~context_sensitive_tokens = + Text_lexer.disable_tokens context_sensitive_tokens; + Text_lexer.reserve_words Config.words + + type 'a memory = + | Amnesic: Cobol_common.Behaviors.amnesic memory + | Eidetic: tokens -> Cobol_common.Behaviors.eidetic memory + + type 'a state = + { + expect_picture_string: bool; + leftover_tokens: tokens; (* non-empty only when [preproc_n_combine_tokens] + errors out for lack of input tokens. *) + memory: 'a memory; + diags: DIAGS.Set.t; + lexing_options: Text_lexer.lexing_options; + } + + let amnesic = Amnesic + let eidetic = Eidetic [] + let init memory ~context_sensitive_tokens = + init_text_lexer ~context_sensitive_tokens; + { + expect_picture_string = false; + leftover_tokens = []; + memory; + diags = DIAGS.Set.none; + lexing_options = Text_lexer.default_lexing_options; + } + + let diagnostics { diags; _ } = diags + let parsed_tokens { memory = Eidetic tokens; _ } = lazy (List.rev tokens) + + let distinguish_words: (Grammar_tokens.token with_loc as 't) -> 't = function + | { payload = WORD w; loc } when loc_in_area_a loc -> + WORD_IN_AREA_A w &@ loc + | t -> t + + let tokens_of_word + { lexing_options = options; _ } + : text_word with_loc -> tokens * DIAGS.Set.t = + fun { payload = c; loc } -> + let tok t = [t &@ loc], DIAGS.Set.none in + match c with + | TextWord w + | CDirWord w + -> let tokens = Text_lexer.tokens_of_string' ~options (w &@ loc) in + List.map distinguish_words tokens, DIAGS.Set.none + | Alphanum { knd = Basic; str; qte = quotation; _ } + when Config.ebcdic_symbolic_characters#value + -> let token, diags = + Text_lexer.decode_symbolic_ebcdics' ~quotation (str &@ loc) in + [token], diags + | Alphanum { knd = Basic; str; qte; _ } + -> tok @@ ALPHANUM (str, qte) + | Alphanum { knd = Bool; str; _ } + -> tok @@ BOOLIT (Cobol_ast.boolean_of_string ~base:`Bool str) + | Alphanum { knd = BoolX; str; _ } + -> tok @@ BOOLIT (Cobol_ast.boolean_of_string ~base:`Hex str) + | Alphanum { knd = Hex; str; _ } + -> tok @@ HEXLIT str (* TODO: decide on a representation *) + | Alphanum { knd = NullTerm; str; _ } + -> tok @@ NULLIT str + | Alphanum { knd = National | NationalX; str; _ } (* TODO: differentiate *) + -> tok @@ NATLIT str + | AlphanumPrefix { str; qte; _ } + -> tok @@ ALPHANUM_PREFIX (str, qte) + | Eof + -> tok EOF + | Pseudo _ + -> [], DIAGS.(Acc.error Set.none) ~loc "Unexpected@ pseudotext" + + let tokens_of_text: 'a state -> text -> tokens * 'a state = fun state -> + (* After text manipulation. We need special handling of `PICTURE [IS]` to + bypass usual tokenization of picture strings. *) + let prod (acc, ({ expect_picture_string; _ } as s)) = function + | { payload = PICTURE; _ } as p -> + p :: acc, { s with expect_picture_string = true } + | { payload = IS; _ } as p + when expect_picture_string -> + p :: acc, { s with expect_picture_string = true } + | p -> + p :: acc, { s with expect_picture_string = false } + in + let tokenize_text_word: string with_loc -> _ = + let tokenizer ~loc lb = + Text_lexer.tokens ~options:state.lexing_options (lb &@ Lazy.force loc) + and prod_tokens t acc = + List.fold_left (fun acc t -> prod acc @@ distinguish_words t) acc ~&t + in + fun w -> + Cobol_common.Tokenizing.fold_tokens ~tokenizer ~f:prod_tokens w + ~until:(function [{ payload = EOF; _ }] -> true | _ -> false) + and prod_word (acc, ({ diags; _ } as state)) word = + let t, diags' = tokens_of_word state word in + let state = { state with diags = DIAGS.Set.union diags diags' } in + List.fold_left prod (acc, state) t + in + let rec acc_text ((_, ({ expect_picture_string; _ })) as acc) word = + if expect_picture_string + then match ~&word with + | TextWord "IS" -> prod acc (IS &@<- word) + | TextWord w -> prod acc (PICTURE_STRING w &@<- word) + | _ -> missing_picstr acc word + else match ~&word with + | TextWord w -> tokenize_text_word (w &@<- word) acc + | _ -> prod_word acc word + and missing_picstr (acc, ({ diags; _ } as state)) ({ loc; _ } as word) = + let state = + { state with + diags = DIAGS.Acc.error diags ~loc "Missing@ PICTURE@ string@ (got@ \ + `%a'@ instead)" TEXT.pp_word word; + expect_picture_string = false } + in + acc_text (acc, state) word + in + fun text -> + let acc, state = List.fold_left acc_text ([], state) text in + List.rev acc, state + + let tokenize_text ~source_format ({ leftover_tokens; _ } as state) text = + let state = { state with leftover_tokens = [] } in + let new_tokens, state = tokens_of_text state text in + let tokens = leftover_tokens @ new_tokens in + match preproc_n_combine_tokens (module Config) ~source_format tokens with + | Ok (tokens, diags) -> + Ok tokens, { state with diags = DIAGS.Set.union diags state.diags } + | Error `MissingInputs -> + Error `MissingInputs, { state with leftover_tokens = tokens } + | Error (`ReachedEOF (loc, extected_item, diags, tokens)) -> + Error (`ReachedEOF tokens), + let diags = DIAGS.Set.union diags state.diags in + { state with + diags = DIAGS.Acc.error diags ~loc "Unterminated %(%)" extected_item } + + let emit_token (type m) (s: m state) tok : m state = + match s.memory with + | Amnesic -> s + | Eidetic toks -> { s with memory = Eidetic (tok :: toks) } + + let put_token_back (type m) (s: m state) : m state = + match s.memory with + | Amnesic -> s + | Eidetic [] -> Fmt.invalid_arg "put_token_back: unexpected memory state" + | Eidetic (_ :: toks) -> { s with memory = Eidetic toks } + + let next_token (type m) (s: m state) = + let rec aux = function + | { payload = INTERVENING_ ','; _ } :: tokens -> + aux tokens + | { payload = INTERVENING_ '.'; loc } :: tokens -> + Some (s, PERIOD &@ loc, tokens) + | token :: tokens -> + Some (emit_token s token, token, tokens) + | [] -> + None + in + aux + + type lexer_update = + | Enabled of Text_lexer.TokenHandles.t + | Disabled of Text_lexer.TokenHandles.t + | CommaBecomesDecimalPoint + + let token_of_string { lexing_options = options; _ } = + Text_lexer.token_of_string' ~options + + let tokens_of_string' { lexing_options = options; _ } = + Text_lexer.tokens_of_string' ~options + + (** Retokenizes the tokens {e after} the given operation has been perfomed on + {!module:Text_lexer}. *) + (* TODO: Find whether everything related to Area A and comma-retokenization + could be moved to Text_lexer *) + let retokenize_after: lexer_update -> _ state -> tokens -> tokens = fun update s -> + match update with + | Enabled tokens | Disabled tokens + when Text_lexer.TokenHandles.is_empty tokens -> + Fun.id + | Enabled _ -> + List.map begin fun token -> match ~&token with + | WORD_IN_AREA_A w + | WORD w -> distinguish_words @@ token_of_string s (w &@<- token) + | _ -> token + end + | Disabled tokens -> + let keyword_of_token = Hashtbl.find Text_lexer.keyword_of_token in + List.map begin fun token -> + if Text_lexer.TokenHandles.mem_text_token ~&token tokens + then match token_in_area_a token, keyword_of_token ~&token with + | true, w -> WORD_IN_AREA_A w &@<- token + | false, w -> WORD w &@<- token + else token + end + | CommaBecomesDecimalPoint -> + (* This may only happen when the comma becomes a decimal separator in + numerical literals, instead of periods. Before this (irreversible) + change, any intervening comma is represented with a special + [INTERVENING_ ','] token in the list of tokens procuded by + {!tokenize_text}. *) + (* Find any INTERVENING_COMMA and retokenize with the two adjacent words + if they are SINTLIT on the left, and DIGITS (or FLOATLIT) on the + right (possible combinations are generated in {!Text_lexer.token}). + To deal with periods, we need to retokenize any FIXEDLIT and + FLOATLIT. *) + let show_fixed (i, c, d) = Pretty.to_string "%s%c%s" i c d in + let show_float (i, c, d, e) = Pretty.to_string "%s%c%sE%s" i c d e in + let rec aux rev_prefix suffix = + match rev_prefix, suffix with + | { payload = SINTLIT l; loc = lloc } :: rev_prefix, + { payload = INTERVENING_ ','; loc = cloc } :: + { payload = DIGITS r; loc = rloc } :: suffix -> + retokenize_with_comma rev_prefix suffix + l lloc cloc r rloc + | { payload = SINTLIT l; loc = lloc } :: rev_prefix, + { payload = INTERVENING_ ','; loc = cloc } :: + { payload = FLOATLIT f; loc = rloc } :: suffix -> + retokenize_with_comma rev_prefix suffix + l lloc cloc (show_float f) rloc + | _, { payload = FIXEDLIT f; loc } :: suffix -> + let toks = tokens_of_string' s (show_fixed f &@ loc) in + aux (List.rev_append toks rev_prefix) suffix + | _, { payload = FLOATLIT f; loc } :: suffix -> + let toks = tokens_of_string' s (show_float f &@ loc) in + aux (List.rev_append toks rev_prefix) suffix + | _, [] -> + List.rev rev_prefix + | _, x :: tl -> + aux (x :: rev_prefix) tl + and retokenize_with_comma rev_prefix suffix l l_loc sep_loc r r_loc = + let loc = Cobol_common.Srcloc.(concat (concat l_loc sep_loc) r_loc) in + let tks = tokens_of_string' s (Pretty.to_string "%s,%s" l r &@ loc) in + aux (List.rev_append tks rev_prefix) suffix + in + aux [] + + (** Enable incoming tokens w.r.t the lexer, and retokenize awaiting tokens + (i.e. that may have been tokenized according to out-of-date rules) *) + let enable_tokens state tokens incoming_tokens = + Text_lexer.enable_tokens incoming_tokens; + state, retokenize_after (Enabled incoming_tokens) state tokens + + (** Disable incoming tokens w.r.t the lexer, and retokenize awaiting tokens + (i.e. that may have been tokenized according to out-of-date rules) *) + let disable_tokens state tokens outgoing_tokens = + Text_lexer.disable_tokens outgoing_tokens; + state, retokenize_after (Disabled outgoing_tokens) state tokens + + let decimal_point_is_comma (type m) (state: m state) token tokens = + let state = put_token_back state in + let state = { state with + lexing_options = { decimal_point_is_comma = true } } in + let tokens = token :: tokens in + let tokens = retokenize_after CommaBecomesDecimalPoint state tokens in + let token, tokens = List.hd tokens, List.tl tokens in + emit_token state token, token, tokens + + let put_token_back state token tokens = + put_token_back state, token :: tokens + +end diff --git a/src/lsp/cobol_parser/text_tokenizer.mli b/src/lsp/cobol_parser/text_tokenizer.mli new file mode 100644 index 000000000..5c71eb18c --- /dev/null +++ b/src/lsp/cobol_parser/text_tokenizer.mli @@ -0,0 +1,97 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Cobol text tokenization *) + +module TEXT = Cobol_preproc.Text + +(** {2 Compilation group tokens} *) + +(** Tokens passed to {!Parser}; can be obtained via {!tokenize_text}. *) +type token = Grammar_tokens.token Cobol_ast.with_loc +type tokens = token list +val pp_token: token Pretty.printer +val pp_tokens: tokens Pretty.printer + +module Make (Config: Cobol_config.T): sig + + (** A type of memory that may either forget or rememeber all parsed tokens. *) + type 'a memory + val amnesic: Cobol_common.Behaviors.amnesic memory + val eidetic: Cobol_common.Behaviors.eidetic memory + + (** State of a tokenizer for compilation group parsing. + + Such a state is needed to deal with token combinations and simple syntax + rules for picture clauses, as well as to keep track of lexer + configurations. + + Contrary to an [eidetic state] that allows to retrieve every previously + parsed token, an [amnesic state] is a tokenizer state that does not keep + hold of any such memory. *) + type 'a state + + (** Initialization function, based on the desired memory and a given set of + tokens that are considered context-sensitive. The latter are {e disabled} + (i.e, not considered as keywords) upon initialization; calls to + {!enable_tokens} or {!disable_tokens} are needed to enable or disable them + when needed. *) + val init + : 'a memory + -> context_sensitive_tokens:Text_lexer.TokenHandles.t + -> 'a state + + val diagnostics + : 'a state + -> Cobol_common.Diagnostics.Set.t + + val parsed_tokens + : Cobol_common.Behaviors.eidetic state + -> tokens Lazy.t + + val tokenize_text + : source_format: _ Cobol_preproc.Src_lexing.source_format + -> 'a state + -> TEXT.t + -> (tokens, [>`MissingInputs | `ReachedEOF of tokens]) result * 'a state + + val next_token + : 'a state + -> tokens + -> ('a state * token * tokens) option + + val enable_tokens + : 'a state + -> tokens + -> Text_lexer.TokenHandles.t + -> 'a state * tokens + + val disable_tokens + : 'a state + -> tokens + -> Text_lexer.TokenHandles.t + -> 'a state * tokens + + val put_token_back + : 'a state + -> token + -> tokens + -> 'a state * tokens + + val decimal_point_is_comma + : 'a state + -> token + -> tokens + -> 'a state * token * tokens + +end diff --git a/src/vscode-js-stubs/version.mlt b/src/lsp/cobol_parser/version.mlt similarity index 100% rename from src/vscode-js-stubs/version.mlt rename to src/lsp/cobol_parser/version.mlt diff --git a/src/lsp/cobol_preproc/README.md b/src/lsp/cobol_preproc/README.md new file mode 100644 index 000000000..d6b0d5647 --- /dev/null +++ b/src/lsp/cobol_preproc/README.md @@ -0,0 +1,5 @@ +# Cobol_preproc package + +This package contains all the preprocessing logic for cobol, as well as the lexing logic. + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_preproc/cobol_preproc.ml b/src/lsp/cobol_preproc/cobol_preproc.ml new file mode 100644 index 000000000..0badb5222 --- /dev/null +++ b/src/lsp/cobol_preproc/cobol_preproc.ml @@ -0,0 +1,22 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Src_overlay = Src_overlay +module Src_lexing = Src_lexing + +module Text = Text +module Text_printer = Text_printer + +module Copybook = Copybook + +include Preproc_engine diff --git a/src/lsp/cobol_preproc/copybook.ml b/src/lsp/cobol_preproc/copybook.ml new file mode 100644 index 000000000..9a55d270d --- /dev/null +++ b/src/lsp/cobol_preproc/copybook.ml @@ -0,0 +1,52 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file.V1 + +type lib_not_found_info = + { + libname: string; + libpath: string list; + } + +(** Filename extensions that we should treat as copybooks and not main + programs. *) +let copybook_extensions = (* this must be a subset of {!libfile_extensions}. *) + [".CPY"; ".cpy"; ".cbx"] + +let libfile_extensions = + [".CPY"; ".CBL"; ".COB"; ".cpy"; ".cbl"; ".cob"; ""; ".cbx"] + +let find_lib ~libpath libname : _ result = + let rec try_file base = function + | [] -> + Error { libname = base; libpath } + | suff :: tl -> + try Ok (EzFile.find_in_path libpath (base ^ suff)) with + | Not_found -> try_file base tl + in + match libname with + | `Word, w -> + begin match try_file w libfile_extensions with + | Ok lib -> Ok lib + | Error _ -> match try_file (String.lowercase_ascii w) libfile_extensions with + | Ok lib -> Ok lib + | Error err -> Error {err with libname = w; } + end + | `Alphanum, w -> try_file w [""] + +let lib_not_found_error k { libname; libpath } = + (* TODO: `note addendum about search path *) + Pretty.delayed_to k + "@[Library@ `%s'@ not@ found@ in@ search@ path@ (search@ path:@ @[%a@])@]" + libname Pretty.path libpath diff --git a/src/lsp/cobol_preproc/copybook.mli b/src/lsp/cobol_preproc/copybook.mli new file mode 100644 index 000000000..f726ebfe8 --- /dev/null +++ b/src/lsp/cobol_preproc/copybook.mli @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +val copybook_extensions: string list + +type lib_not_found_info = + { + libname: string; + libpath: string list; + } + +val lib_not_found_error: (Pretty.delayed -> 'a) -> lib_not_found_info -> 'a + +val find_lib + : libpath:string list + -> [< `Alphanum | `Word ] * string + -> (string, lib_not_found_info) result diff --git a/src/lsp/cobol_preproc/dune b/src/lsp/cobol_preproc/dune new file mode 100644 index 000000000..7052036d7 --- /dev/null +++ b/src/lsp/cobol_preproc/dune @@ -0,0 +1,44 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_preproc) + (public_name cobol_preproc) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ppx_deriving menhirLib cobol_config cobol_common str) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show)) + + ) + +(ocamllex src_lexer) + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_preproc)) + +; use field 'dune-trailer' to add more stuff here +(menhir (modules preproc_tokens grammar_common preproc_grammar) + (merge_into preproc_grammar) + (flags --cmly --table + --external-tokens Preproc_tokens)) + +(menhir (modules preproc_tokens) + (flags --only-tokens)) + +(rule + (targets preproc_keywords.ml) + (enabled_if (<> %{profile} "release")) + (deps preproc_grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:../cobol_parser/keywords/gen_keywords.exe} %{deps} + --external-tokens Preproc_tokens)))) + diff --git a/src/lsp/cobol_preproc/grammar_common.mly b/src/lsp/cobol_preproc/grammar_common.mly new file mode 100644 index 000000000..6bca1937e --- /dev/null +++ b/src/lsp/cobol_preproc/grammar_common.mly @@ -0,0 +1,103 @@ +%{ +(**************************************************************************) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +%} + +%% + +(* TODO: add a `recovery.benign` attribute as this can be empty *) +%public l [@recovery []] [@symbol ""] (X): + | /* empty */ { [] } + | x = X l = l(X) { x :: l } + +(* TODO: add a `recovery.benign` attribute as this can be empty *) +%public rl [@recovery []] [@symbol ""] (X): (* auto-recovery *) + | x = list(X) { x } + +%public ntl [@recovery []] (X): + | x1 = X x2 = X { [x1; x2] } + | x = X l = ntl(X) { x :: l } + +%public %inline ll(X): + | l = ll_rev(X) { List.rev l } + +ll_rev(X): + | /* empty */ { [] } + | l = ll_rev(X) x = X { x :: l } + +%public %inline nell(X): + | l = nell_rev(X) { List.rev l } + +nell_rev(X): + | x = X { [x] } + | l = nell_rev(X) x = X { x :: l } + +%public +let rnell(X) == l = rnell_rev(X); { List.rev l } +let rnell_rev [@recovery []] (X) := + | x = X; { [x] } + | l = rnell_rev(X); x = X; { x :: l } + +%public %inline ntll(X): + | l = ntll_rev(X) { List.rev l } + +ntll_rev(X): + | x1 = X x2 = X { [x2; x1] } + | l = ntll_rev(X) x = X { x :: l } + +(* TODO: add a `recovery.benign` attribute *) +%public ro [@recovery None] [@symbol ""] (X): (* auto-recovery *) + | x = option(X) { x } + +%public %inline o (X): + | x = option(X) { x } + +%public %inline bo(X): + | x = boption(X) { x } + +%public %inline lo(X): + | x = loption(X) { x } + +%public %inline io(X): + | x = ioption(X) { x } + +%public %inline ibo(X): + | /* nothing */ { false } + | X { true } + +%public %inline ilo(X): + | /* nothing */ { [] } + | x = X { x } + +%public %inline mr(X): + | x = midrule(X) { x } + +%public %inline er(X): + | x = endrule(X) { x } + +%public %inline or_(X,Y): + | X | Y {} + +%public %inline pf(p, X): + | p; x = X { x } + +%public %inline sf(X, s): + | x = X; s { x } + +%public %inline psf(p, X, s): +| p; x = X; s { x } + +%public %inline id(X): + | x = X { x } + +%% diff --git a/src/lsp/cobol_preproc/index.mld b/src/lsp/cobol_preproc/index.mld new file mode 100644 index 000000000..ce19e10fa --- /dev/null +++ b/src/lsp/cobol_preproc/index.mld @@ -0,0 +1,9 @@ +{1 Library cobol_preproc} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package contains all the preprocessing logic for cobol, as well as the lexing logic. + +The entry point of this library is the module: {!Cobol_preproc}. + diff --git a/src/lsp/cobol_preproc/package.toml b/src/lsp/cobol_preproc/package.toml new file mode 100644 index 000000000..b841ab7cc --- /dev/null +++ b/src/lsp/cobol_preproc/package.toml @@ -0,0 +1,99 @@ + +# name of package +name = "cobol_preproc" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +generators = ["ocamllex"] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show" + +# files to skip while updating at package level +skip = ["main.ml", "index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_common = "version" +cobol_config = "version" +ppx_deriving = ">=5.2.1" +[dependencies.menhir] +libname = "menhirLib" +version = ">=1.2" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +dune-libraries = "str" +dune-trailer = """ +(menhir (modules preproc_tokens grammar_common preproc_grammar) + (merge_into preproc_grammar) + (flags --cmly --table + --external-tokens Preproc_tokens)) + +(menhir (modules preproc_tokens) + (flags --only-tokens)) + +(rule + (targets preproc_keywords.ml) + (enabled_if (<> %{profile} "release")) + (deps preproc_grammar.cmly) + (mode promote) + (action + (with-stdout-to %{targets} + (run %{exe:../cobol_parser/keywords/gen_keywords.exe} %{deps} + --external-tokens Preproc_tokens)))) +""" +menhir-flags = "--table" diff --git a/src/lsp/cobol_preproc/preproc.ml b/src/lsp/cobol_preproc/preproc.ml new file mode 100644 index 000000000..276df5aa4 --- /dev/null +++ b/src/lsp/cobol_preproc/preproc.ml @@ -0,0 +1,740 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ez_file.V1 +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX +open Cobol_common.Diagnostics.TYPES +open Text.TYPES + +module DIAGS = Cobol_common.Diagnostics + +(* --- *) + +include Preproc_tokens (* include token type directly *) + +(* --- *) + +type 'k srclexer = 'k Src_lexing.state * Lexing.lexbuf +and any_srclexer = + | Plx: 'k srclexer -> any_srclexer [@@unboxed] +let srclex_lexbuf (Plx (_, lexbuf)) = lexbuf +let srclex_pos pl = (srclex_lexbuf pl).Lexing.lex_curr_p +let srclex_diags (Plx (pl, _)) = + Src_lexing.diagnostics pl +let srclex_source_format (Plx (pl, _)) = + Src_lexing.(source_format_spec @@ source_format pl) + +type 'k source_line = + | Line: 'k srclexer * text -> 'k source_line + +let source_lines_reader lexer = + let rec next_source_line (state, lexbuf) = + let state, pseutoks = lexer state lexbuf in + match pseutoks with + | [] -> next_source_line (state, lexbuf) (* skip blank lines *) + | _ -> Line ((state, lexbuf), pseutoks) + in + next_source_line + +let fold_source_lines lexer f pl = + let next_source_line = source_lines_reader lexer in + let rec aux pl acc = match next_source_line pl with + | Line (_, [{ payload = Eof; _}]) -> acc + | Line (pl, text) -> f text acc |> aux pl + in + aux pl + +let print_source_lines lexer ppf pl = + fold_source_lines lexer (fun t () -> Pretty.print ppf "%a@." Text.pp_text t) + pl () + +let next_source_line (Plx pl) = + let Line (pl, text) = source_lines_reader Src_lexer.line pl in + Plx pl, text + +let print_source_lines ppf (Plx pl) = + print_source_lines Src_lexer.line ppf pl + +let fold_source_lines pl f acc = + let rec aux pl acc = match next_source_line pl with + | _, [{ payload = Eof; _}] -> acc + | pl, text -> aux pl (f text acc) + in + aux pl acc + +(* --- *) + +let with_source_format + : 'k Src_lexing.source_format with_loc -> (any_srclexer as 'x) -> 'x + = fun format ((Plx (s, lexbuf)) as pl) -> + if Src_lexing.(same_source_formats @@ source_format s) ~&format + then pl + else match Src_lexing.change_source_format s format with + | Ok s -> Plx (s, lexbuf) + | Error s -> Plx (s, lexbuf) + +let make_srclex make_lexing on_period_only ?filename ~source_format input = + let SF source_format = Src_lexing.select_source_format source_format in + (* Be sure to provide position informations *) + let lexbuf = make_lexing ?with_positions:(Some true) input in + Option.iter (Lexing.set_filename lexbuf) filename; + Plx (Src_lexing.init_state on_period_only source_format, lexbuf) + +let srclex_from_string = make_srclex Lexing.from_string +let srclex_from_channel = make_srclex Lexing.from_channel +let srclex_from_file on_period_only ~source_format filename : any_srclexer = + srclex_from_string on_period_only ~source_format ~filename + (EzFile.read_file filename) + +(* --- Compiler Directives -------------------------------------------------- *) + +(* SOURCE FORMAT *) + +type lexing_directive = + | LexDirSource + : 'k Src_lexing.source_format with_loc -> lexing_directive [@@unboxed] + +let cdir_source_format ~dialect format = + match Src_lexing.decypher_source_format ~dialect ~&format with + | Ok sf -> + let SF sf = Src_lexing.select_source_format sf in + DIAGS.some_result @@ LexDirSource (sf &@<- format) + | Error (`SFUnknown f) -> + DIAGS.no_result + ~diags:(DIAGS.Set.one @@ + DIAGS.One.error ~loc:~@format "Unknown@ source@ format@ `%s'" f) + +(* COPY/REPLACING *) + +type copy_statement = + | CDirCopy of + { + library: library; + suppress_printing: bool; + replacing: replacing with_loc list; + } +and replace_statement = + | CDirReplace of + { + also: bool; + replacing: replacing with_loc list; + } + | CDirReplaceOff of + { + last: bool; + } +and library = + { + libname: fileloc with_loc; + cbkname: fileloc with_loc option; + } +and fileloc = [`Word | `Alphanum] * string +and replacing = + | ReplaceExact of + { + repl_from: pseudotext with_loc; + repl_to: pseudotext with_loc; + } + | ReplacePartial of + { + repl_subst: partial_subst with_loc; + repl_to: string with_loc option; + } +and partial_subst = + { + partial_subst_dir: Cobol_common.Srcloc.leading_or_trailing; + partial_subst_len: int; + partial_subst_regexp: Str.regexp; + } + +type log_entry = + { + matched_loc: srcloc; + replacement_text: text; + } +type log = log_entry list + +(* --- Implementation of replacing operations ------------------------------- *) + +let concat_strings = Cobol_common.Srcloc.concat_strings_with_loc +let lift_textword w = TextWord ~&w &@<- w + +(* TODO: raise (a) dedicated exception(s), and catch it in the preprocessor + engine to try and continue pre-processing. *) + +let nonempty_words words : _ result = match ~&words with + | [] -> + Error (DIAGS.One.error ~loc:~@words "Expected@ at@ least@ one@ text-word") + | _ -> + Ok words + +type _ partial_word_request = + | ExactlyOne: string with_loc partial_word_request + | AtMostOne: string with_loc option partial_word_request + +let partial_word (type k) (req: k partial_word_request) words : (k, _) result = + match ~&words, req with + | [], AtMostOne -> + Ok None + | [{ payload = PseudoWord [{ payload = PwText w | PwDelim (w, _); _ }]; + loc }], AtMostOne -> + Ok (Some (w &@ loc)) + | [{ payload = PseudoWord [{ payload = PwText w | PwDelim (w, _); _ }]; + loc }], ExactlyOne -> + Ok (w &@ loc) + | [{ payload = PseudoAlphanum _; _ }], _ -> + Error (DIAGS.One.error ~loc:~@words "Unexpected@ alphanumeric@ literal") + | _, AtMostOne -> + Error (DIAGS.One.error ~loc:~@words "Expected@ at@ most@ one@ text-word") + | _, _ -> + Error (DIAGS.One.error ~loc:~@words "Expected@ one@ text-word") + +type partial_replacing = + { + repl_dir: Cobol_common.Srcloc.leading_or_trailing; + repl_strict: bool; + } + +let partial_subst (k: partial_replacing) ({ payload = pat; _ } as repl_from) = + { partial_subst_dir = k.repl_dir; + partial_subst_len = String.length pat; + partial_subst_regexp = Str.regexp @@ match k.repl_dir with + | Leading when k.repl_strict -> "^" ^ Str.quote pat ^ "\\(.+\\)$" + | Leading -> "^" ^ Str.quote pat ^ "\\(.*\\)$" + | Trailing when k.repl_strict -> "^\\(.+\\)" ^ Str.quote pat ^ "$" + | Trailing -> "^\\(.*\\)" ^ Str.quote pat ^ "$" + } &@<- repl_from + +let exact_replacing repl_from repl_to = + match nonempty_words repl_from with + | Ok repl_from -> + DIAGS.some_result @@ ReplaceExact { repl_from; repl_to } + | Error diag -> + DIAGS.no_result ~diags:(DIAGS.Set.one diag) + +let partial_replacing partial_replacing repl_from repl_to = + match partial_word ExactlyOne repl_from, + partial_word AtMostOne repl_to with + | Ok repl_from, + Ok repl_to -> + let repl_subst = partial_subst partial_replacing repl_from in + DIAGS.some_result @@ ReplacePartial { repl_subst; repl_to } + | Error diag, Ok _ + | Ok _, Error diag -> + DIAGS.no_result ~diags:(DIAGS.Set.one diag) + | Error diag, + Error diag' -> + DIAGS.no_result ~diags:(DIAGS.Set.two diag diag') + +let replacing ?partial repl_from repl_to = match partial with + | None -> exact_replacing repl_from repl_to + | Some k -> partial_replacing k repl_from repl_to + +(* --- *) + +let try_partial_subst ~replloc { partial_subst_dir = dir; + partial_subst_len = pat_len; + partial_subst_regexp } s = + let replace s_loc = + Cobol_common.Srcloc.replacement ~replloc + ~in_area_a:(Cobol_common.Srcloc.in_area_a s_loc) + in + let leading s_suffix s_loc prefix = (* replacing s_prefix with prefix *) + let pref_loc = Cobol_common.Srcloc.prefix pat_len s_loc + and suff_loc = Cobol_common.Srcloc.trunc_prefix pat_len s_loc in + let suff = s_suffix &@ suff_loc in + let res = match prefix with + | None -> (* replace with SPACES *) + suff + | Some { payload = new_prefix; loc = new_ } -> + concat_strings (new_prefix &@ replace s_loc ~old:pref_loc ~new_) suff + in + res, pref_loc + and trailing s_prefix s_loc suffix = (* replacing s_suffix with suffix *) + let suff_loc = Cobol_common.Srcloc.suffix pat_len s_loc + and pref_loc = Cobol_common.Srcloc.trunc_suffix pat_len s_loc in + let pref = s_prefix &@ pref_loc in + let res = match suffix with + | None -> (* replace with SPACES *) + pref + | Some { payload = new_suffix; loc = new_ } -> + concat_strings pref (new_suffix &@ replace s_loc ~old:suff_loc ~new_) + in + res, suff_loc + in + let replace = match dir with Leading -> leading | Trailing -> trailing in + if Str.string_match partial_subst_regexp ~&s 0 + then Ok (replace (Str.matched_group 1 ~&s) ~@s) + else Error () + +(* --- *) + +let alphanum_exact_match + { str = s1; qte = q1; knd = k1 } + { str = s2; qte = q2; knd = k2 } + = + q1 = q2 && k1 = k2 && s1 = s2 + +(** [pseudotext_exact_match pseudotext text] returns either a triple [(prefix, + suffix, text_suffix)] if [text] exactly matches a non-empty [pseudotext], an + error code otherwise. + + The error code indicates whether [text] does not match [pseudotext] + ([`Mismatch]), or [text] matches a prefix of [pseudotext] ([`MissingText]). + + In case of a successful match, [prefix = Some p] iff [text] starts with a + text-word [w = p ^ d ^ w'] where [p] is a non-empty string, [d] is a + pseudotext delimiter (`:', `(', or `)'), and [d ^ w'] participated in the + match. + + Likewise, in case of a successful match, [suffix = Some s] iff [text] + terminates with a text-word [w = w' ^ d ^ s] where [s] is a non-empty string, + [d] is a pseudotext delimiter (`:', `(', or `)'), and [w' ^ d] participated + in the match. + + [text_suffix] is the suffix of text that did not participate in the + match. *) +let pseudotext_exact_match + : pseudotext -> text -> + ('s option * 's option * srcloc * text, [> `Mismatch | `MissingText]) result = + let starts_with ~prefix s = + s = prefix || + let pl = String.length prefix in + String.length s >= pl && Str.first_chars s pl = prefix + and cut w d = (* removes [d], assumed to be a prefix of [w], from [w] *) + let dlen = String.length d in + Str.string_after w dlen, dlen + and take_loc_prefix = Cobol_common.Srcloc.prefix + and trunc_loc_prefix = Cobol_common.Srcloc.trunc_prefix in + let cut_text_prefix w wloc pw tl = match cut w pw with + | "", _ -> tl + | w, len -> (TextWord w &@ trunc_loc_prefix len wloc) :: tl + and cut_word_prefix w wloc d = match cut w d with + | "", _ -> None + | w, len -> Some (w &@ trunc_loc_prefix len wloc) + and cut_pw_prefix pw pwloc pwtl pl = match pwtl with + | [] -> pl + | tl -> (PseudoWord tl &@ trunc_loc_prefix (String.length pw) pwloc) :: pl + in + let concat_rev_srclocs l = + Option.get @@ Cobol_common.Srcloc.concat_srclocs @@ List.rev l + in + let rec aux ?prefix ?(seek_delim = false) tlocs pseudotext text : _ result = + match text, pseudotext with + | [], _ -> + (* We assume [pseudotext] is never initially empty upon call, so we can + start by decomposing text. *) + Error `MissingText + | _, [] -> + (* If pseudotext is empty at this point, we have a match. *) + Ok (prefix, None, concat_rev_srclocs tlocs, text) + | t :: tl, p :: pl -> + (* Otherwise, consider the next pseudoword and match against the + left-most word in [text] ([t]): *) + match ~&t, ~&p with + | TextWord w, + PseudoWord [{ payload = PwText pw; _ }] + when w <> pw -> + (* Pseudotext ends with a text-word [pw] that does not match [w]. *) + Error `Mismatch + + | TextWord w, + PseudoWord [{ payload = PwDelim (d, _); _ }] + when pl = [] && starts_with ~prefix:d w -> + (* Pseudotext ends with delimiter [d], matched by [w]. *) + let d_loc = take_loc_prefix (String.length d) ~@t in + let matchloc = concat_rev_srclocs (d_loc :: tlocs) in + Ok (prefix, cut_word_prefix w ~@t d, matchloc, tl) + + | TextWord w, + PseudoWord ({ payload = PwText pw | PwDelim (pw, _); _ } as pwt :: pwtl) + when starts_with ~prefix:pw w -> (* [w] matches pseudotext. *) + let res = + let pw_loc = take_loc_prefix (String.length pw) ~@t in + aux ?prefix (pw_loc :: tlocs) (* Recurse without matched prefix. *) + (cut_pw_prefix pw ~@p pwtl pl) (cut_text_prefix w ~@t pw tl) + in + (match res, ~&pwt with + | Ok _ as ok, _ -> ok + | Error `Mismatch, PwDelim d when seek_delim -> + (* Continue searching in [w] if [pwt] is a delimiter [d]. *) + aux_seek_delim ?prefix tlocs w ~@t d p pl tl + | Error _ as e, _ -> e) + + | TextWord w, + PseudoWord ({ payload = PwDelim d; _ } :: _) + when seek_delim -> + (* Case of initial search for a delimiter. *) + aux_seek_delim ?prefix tlocs w ~@t d p pl tl + + | Alphanum ta, + PseudoAlphanum pa + when alphanum_exact_match ta pa -> + (* Matched an alphanumeric literal: simply recurse. *) + aux ?prefix (~@t :: tlocs) pl tl + + | _ -> + Error `Mismatch + + and aux_seek_delim ?prefix tlocs w wloc (d, d_re) p pl tl = + let dlen = String.length d in + (* Try matching from a _second_ occurrence of a pseudotext delimiter [d] in + [w] if [d] is a prefix of [w], a _first_ occurrence otherwise. *) + let vw = match Str.bounded_full_split d_re w 2 with + | Str.[Delim _] -> + Some (d &@ take_loc_prefix dlen wloc, tl) + | Str.[Delim _; Text w] -> + let dloc = take_loc_prefix dlen wloc in + let wloc = trunc_loc_prefix dlen wloc in + Some (d &@ dloc, lift_textword (w &@ wloc) :: tl) + | Str.[Text v; Delim _] -> + let vlen = String.length v in + let vloc = take_loc_prefix vlen wloc in + let dwloc = trunc_loc_prefix vlen wloc in + let dloc = take_loc_prefix dlen dwloc in + Some (v &@ vloc, lift_textword (d &@ dloc) :: tl) + | Str.[Text v; Delim _; Text w] -> + let vlen = String.length v in + let vloc = take_loc_prefix vlen wloc in + let dwloc = trunc_loc_prefix vlen wloc in + let dloc = take_loc_prefix dlen dwloc in + let dw = concat_strings (d &@ dloc) (w &@ wloc) in + Some (v &@ vloc, lift_textword dw :: tl) + | _ -> None + in + match vw with + | Some (v, w) -> + let prefix = match prefix with + | None when ~&v = "" -> None + | None -> Some v + | Some p -> Some (concat_strings p v) + in + aux ?prefix ~seek_delim:true tlocs (p :: pl) w + | None -> + Error `Mismatch + in + aux ?prefix:None ~seek_delim:true [] + +(** [textword_partial_replace ~replloc partial_subst str text] checks whether + the left-most word in [text] is a text-word [tw], and then tries to apply + [partial_subst str tw] to obtain [y]. It returns either a pair [(y, + text_suffix)] if successful, or an error code otherwise. + + The error code indicates whether [tw] does not comply with [try_subst] + ([`Mismatch]), or [text] is empty ([`MissingText]). *) +let textword_partial_replace + : replloc:srcloc -> partial_subst with_loc -> string with_loc option -> text -> + ((string with_loc * srcloc) * text, [>`MissingText | `Mismatch]) result + = fun ~replloc partial_subst repl_to -> function + | [] -> Error `MissingText + | { payload = TextWord w; loc } :: tl -> + (match try_partial_subst ~replloc ~&partial_subst (w &@ loc) with + | Ok subst -> Ok (subst repl_to, tl) + | Error () -> Error `Mismatch) + | _ -> Error `Mismatch + +let to_text ~replloc ~old pseudotext : text = + let replace item_loc = + Cobol_common.Srcloc.replacement ~replloc ~old ~new_:item_loc + ~in_area_a:(Cobol_common.Srcloc.in_area_a item_loc) + in + let string s = ~&s &@ replace ~@s in + List.filter_map begin fun pseudoword -> match ~&pseudoword with + | PseudoAlphanum a -> + Some (Alphanum a &@ replace ~@pseudoword) + | PseudoWord ps -> + Option.map lift_textword (Text.join_pseudo_string ~string ps) + end ~&pseudotext + +(** [delim left text right], prepends [left] to the left-most text-word in + [text] if [left] is not [None], and appends [right] to the right-most + text-word in [text], if [right] is not [None]. *) +let delim left text right = + let textword_cat op top s text = match s with + | None -> text + | Some s -> + let s' = lift_textword s in + top @@ match top text with + | [] -> + [s'] + | { payload = TextWord w; loc } :: tl -> + lift_textword (op (w &@ loc) s) :: tl + | t :: tl -> + s' :: t :: tl + in + text |> + textword_cat (fun w s -> concat_strings w s) List.rev right |> + textword_cat (fun w s -> concat_strings s w) Fun.id left + +let try_replacing_clause: replacing with_loc -> text -> _ result = fun replacing -> + (* Helpers to record replacement operations on source locations: *) + let replloc = ~@replacing in + match ~&replacing with + | ReplaceExact { repl_from; repl_to } -> + begin fun text -> + match pseudotext_exact_match ~&repl_from text with + | Ok (l, r, matched_loc, suffix) -> + let replacement_text = to_text ~replloc repl_to ~old:matched_loc in + let log_entry = { matched_loc; replacement_text } in + Ok (delim l replacement_text r, log_entry, suffix) + | Error _ as e -> + e + end + | ReplacePartial { repl_subst; repl_to } -> + begin fun text -> + match textword_partial_replace ~replloc repl_subst repl_to text with + | Ok ((t, matched_loc), suffix) when ~&t = "" -> + Ok ([], { matched_loc; replacement_text = [] }, suffix) + | Ok ((t, matched_loc), suffix) -> + let replacement_text = [lift_textword t] in + let log_entry = { matched_loc; replacement_text } in + Ok (replacement_text, log_entry, suffix) + | Error _ as e -> + e + end + +type partial_text_repl = [`NoReplacement | `MissingText] +type full_text_repl = [`NoReplacement] +type partial_text_repl_result = + (text * log, [`MissingText of text * log * text]) result +type (_, _) repl_attempt = + | OnPartText: (partial_text_repl, partial_text_repl_result) repl_attempt + | OnFullText: (full_text_repl, text * log) repl_attempt + +let rec try_replacing_phrase + : type p q. (p, q) repl_attempt -> _ -> text -> (_, p) result = + fun k repl text -> + match repl, k with + | [], OnPartText -> Error `NoReplacement + | [], OnFullText -> Error `NoReplacement + | repl :: tl, _ -> match try_replacing_clause repl text, k with + | Ok _ as res, _ -> res + | Error `MissingText, OnPartText -> Error `MissingText + | Error _, _ -> try_replacing_phrase k tl text + +(** [apply_replacing attempt repl text] applies the replacing clauses [repl] to + [text], and returns a result that depends on whether the given text may be + continued ([attempt = OnPartText]) or not ([attempt = OnFullText]). *) +let apply_replacing k repl log = + let rec aux: type p q. (p, q) repl_attempt -> text -> log -> text -> q = + fun k done_text log text -> + match k, try_replacing_phrase k repl text, text with + | OnPartText, Ok (done_text', le, []), _ -> + Ok (done_text @ done_text', le :: log) + | OnFullText, Ok (done_text', le, []), _ -> + done_text @ done_text', le :: log + | _, Ok (done_text', le, text), _ -> + aux k (done_text @ done_text') (le :: log) text + | OnPartText, Error `MissingText, _ -> + Error (`MissingText (done_text, log, text)) + | OnPartText, Error `NoReplacement, [] -> + Ok (done_text, log) + | OnFullText, Error `NoReplacement, [] -> + done_text, log + | _, Error _, x :: text -> + aux k (done_text @ [x]) log text + in + aux k [] log + +(* --- *) + +type state = + | AllowAll + | AfterControlDivisionHeader + | AfterSubstitSectionHeader + | AllowReplace + | ForbidReplace +let initial_state = AllowAll + +type preproc_phrase = + | Copy of phrase + | Replace of phrase + | Header of tracked_header * phrase +and phrase = + { + prefix: text; + phrase: text; + suffix: text; + } +and tracked_header = + | ControlDivision + | SubstitutionSection + | IdentificationDivision + +(** [find_phrase first_word ~prefix text] looks for a phrase start starts with + [first_word] and terminates with a period in [text]. If [prefix = `Rev] and + upon success, the prefix is reveresed in the returned structure. *) +let find_phrase first_word ?(prefix = `Same) text : _ result = + let split_at_first = Cobol_common.Basics.LIST.split_at_first in + let split_before_word = + split_at_first ~prefix ~where:`Before (Text.textword_eqp ~eq:first_word) + and split_after_period = + split_at_first ~prefix:`Same ~where:`After (Text.textword_eqp ~eq:".") + in + match split_before_word text with + | Error () -> + Error `NoneFound + | Ok (prefix, phrase) -> + match split_after_period phrase with + | Error () -> + Error `MissingPeriod + | Ok (phrase, suffix) -> + Ok { prefix; phrase; suffix } + +(** [find_full_phrase words ~search_deep ~try_hard ~prefix text] looks for a + pharse comprised of all words in [words] and termiates with a period in + [text]. If [prefix = `Rev] and upon success, the prefix is reveresed in the + returned structure. + + - [search_deep] indicates whether the phrase may not start at the first + word; + + - [try_hard] indicates whether the phrase may be preceded by incomplete + prefixes. +*) +let find_full_phrase all_words + ?(prefix = `Same) ?(search_deep = false) ?(try_hard = false) + : text -> _ result = + let all_words = all_words @ ["."] in + let split_at_first = Cobol_common.Basics.LIST.split_at_first in + let split_before_word first_word = + split_at_first ~prefix ~where:`Before (Text.textword_eqp ~eq:first_word) + and split_after_period = + split_at_first ~prefix:`Same ~where:`After (Text.textword_eqp ~eq:".") + and check_phrase = + let rec aux words phrase = match words, phrase with + | [], _ -> Ok () + | _ :: _, [] -> Error `MissingText + | w :: wtl, w' :: w'tl when Text.textword_eqp ~eq:w w' -> aux wtl w'tl + | _ -> Error `NoneFound + in + aux all_words + in + let rec try_from text : _ result = + match split_before_word (List.hd all_words) text with + | Error () -> + Error `NoneFound + | Ok (prefix_text, phrase) -> + try_from_first_word prefix_text phrase + and try_from_first_word prefix_text phrase = + match split_after_period phrase with + | Error () -> + Error `MissingPeriod + | Ok (phrase, suffix) -> + match check_phrase phrase with + | Ok () -> + Ok { prefix = prefix_text; phrase; suffix } + | Error `MissingText as e -> + e + | Error `NoneFound as e when not try_hard -> + e + | Error `NoneFound -> + (* Note: even when trying hard, we make the simplifying + assumption the given words allow us to continue with `suffix` + and not from the second word in `phrase`. *) + match try_from suffix, prefix with + | Error _ as e, _ -> + e + | Ok phrase, `Same -> + Ok { phrase with prefix = prefix_text @ phrase.prefix } + | Ok phrase, `Rev -> + Ok { phrase with prefix = phrase.prefix @ prefix_text } + in + if search_deep + then try_from + else try_from_first_word [] + +(** [find_preproc_phrase ~prefix state text] attempts to find a phrase in [text] + that is relevant in preprocessing state [state]. Returned phrases have a + [prefix] text that is reversed when [prefix = `Rev]. *) +let find_preproc_phrase ?prefix = + (* NB: This is a somewhat hackish and manual encoding of a state machine, used + to only allow a single REPLACE wihtin the SUBSTITUTION SECTION of the + CONTROL DIVISION; if such a REPLACE is present, then it must be the only + one in the compilation group. + + NOTE: for now the aforementiones division and section headers are detected + only when they start at the very begining of the given text. This seems to + be ok as long as they are preceded with a period (.), since we perform the + search on a sentence-by-sentence basis. + + CHECKME: the SUBSTITUTION SECTION may only be allowed after or before the + DEFAULT SECTION. *) + let find_phrase = find_phrase ?prefix + and find_full_phrase = find_full_phrase ?prefix in + let find_cntrl_div_header = find_full_phrase ["CONTROL"; "DIVISION"] + and find_ident_div_header = find_full_phrase ["IDENTIFICATION"; "DIVISION"] + and find_subst_sec_header = find_full_phrase ["SUBSTITUTION"; "SECTION"] in + let try_replace ~next src = + match find_phrase "REPLACE" src with + | Ok repl -> Ok (Replace repl, next) + | Error _ as e -> e + in + let try_identification_division_header ?(next = AllowReplace) src = + match find_ident_div_header src with + | Ok x -> Ok (Header (IdentificationDivision, x), next) + | Error `NoneFound -> try_replace ~next src + | Error _ as e -> e + in + let try_control_division_header src = + match find_cntrl_div_header src with + | Ok x -> Ok (Header (ControlDivision, x), AfterControlDivisionHeader) + | Error `NoneFound -> try_identification_division_header src + | Error _ as e -> e + in + let try_substitution_section_header src = + match find_subst_sec_header src with + | Ok x -> Ok (Header (SubstitutionSection, x), AfterSubstitSectionHeader) + | Error `NoneFound -> try_identification_division_header src + | Error _ as e -> e + in + fun state src -> + (* Note COPY takes precedence over REPLACE, as per the ISO/IEC 2014 + standard, 7.2 Text manipulation. *) + match find_phrase "COPY" src, state with + | Ok copy, _ -> + Ok (Copy copy, state) + | Error `MissingPeriod as e, _ -> + e + | Error `NoneFound, AllowAll -> + try_control_division_header src + | Error `NoneFound, AllowReplace -> + try_replace ~next:AllowReplace src + | Error `NoneFound, ForbidReplace -> + Error `NoneFound + | Error `NoneFound, AfterControlDivisionHeader -> + try_substitution_section_header src + | Error `NoneFound, AfterSubstitSectionHeader -> + try_identification_division_header ~next:ForbidReplace src + +(* --- *) + +module type ENTRY_POINTS = sig + type 'x entry + val replace_statement: replace_statement with_diags with_loc entry + val lexing_directive: lexing_directive option with_diags with_loc entry + val copy_statement: copy_statement with_diags with_loc entry +end + +module type PPPARSER = sig + exception Error + + (* The incremental API. *) + module MenhirInterpreter: MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE + with type token = token + + (* The entry point(s) to the incremental API. *) + module Incremental: ENTRY_POINTS with type + 'x entry := Lexing.position -> 'x MenhirInterpreter.checkpoint +end diff --git a/src/lsp/cobol_preproc/preproc.mli b/src/lsp/cobol_preproc/preproc.mli new file mode 100644 index 000000000..44bfcbc0b --- /dev/null +++ b/src/lsp/cobol_preproc/preproc.mli @@ -0,0 +1,174 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Diagnostics.TYPES +open Text.TYPES + +type 'k srclexer = 'k Src_lexing.state * Lexing.lexbuf +and any_srclexer = + | Plx: 'k srclexer -> any_srclexer [@@unboxed] + +(* --- Compiler Directives -------------------------------------------------- *) + +(* SOURCE FORMAT *) + +type lexing_directive = + | LexDirSource: + 'k Src_lexing.source_format with_loc -> lexing_directive [@@unboxed] + +(* COPY/REPLACING *) + +type copy_statement = + | CDirCopy of + { + library: library; + suppress_printing: bool; + replacing: replacing with_loc list; + } +and replace_statement = + | CDirReplace of + { + also: bool; + replacing: replacing with_loc list; + } + | CDirReplaceOff of + { + last: bool; + } +and library = + { + libname: fileloc with_loc; + cbkname: fileloc with_loc option; + } +and fileloc = [`Word | `Alphanum] * string +and replacing + +type log_entry = + { + matched_loc: srcloc; + replacement_text: text; + } +type log = log_entry list + +type (_, _) repl_attempt = + | OnPartText: ([`NoReplacement | `MissingText], + partial_text_repl_result) repl_attempt + | OnFullText: ([`NoReplacement], + text * log) repl_attempt +and partial_text_repl_result = + (text * log, [`MissingText of text * log * text]) result + +module type ENTRY_POINTS = sig + type 'x entry + val replace_statement: replace_statement with_diags with_loc entry + val lexing_directive: lexing_directive option with_diags with_loc entry + val copy_statement: copy_statement with_diags with_loc entry +end + +module type PPPARSER = sig + exception Error + + (* The incremental API. *) + module MenhirInterpreter: MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE + with type token = Preproc_tokens.token + + (* The entry point(s) to the incremental API. *) + module Incremental: ENTRY_POINTS with type + 'x entry := Lexing.position -> 'x MenhirInterpreter.checkpoint +end + +type partial_replacing = + { + repl_dir: Cobol_common.Srcloc.leading_or_trailing; + repl_strict: bool; + } +val replacing + : ?partial:partial_replacing + -> pseudotext with_loc + -> pseudotext with_loc + -> replacing option with_diags +val apply_replacing + : (_, 'a) repl_attempt + -> replacing with_loc list + -> log + -> text + -> 'a + +val srclex_diags + : any_srclexer + -> Cobol_common.Diagnostics.Set.t + +val cdir_source_format + : dialect: Cobol_config.dialect + -> string with_loc + -> lexing_directive option with_diags +val srclex_source_format + : any_srclexer + -> Cobol_config.source_format +val with_source_format + : 'k Src_lexing.source_format with_loc + -> any_srclexer + -> any_srclexer + +val srclex_pos + : any_srclexer + -> Lexing.position +val srclex_from_file + : bool + -> source_format:Cobol_config.source_format + -> string + -> any_srclexer +val srclex_from_string + : bool + -> ?filename: string + -> source_format:Cobol_config.source_format + -> string + -> any_srclexer +val srclex_from_channel + : bool + -> ?filename: string + -> source_format:Cobol_config.source_format + -> in_channel + -> any_srclexer + +val next_source_line: any_srclexer -> any_srclexer * text +val fold_source_lines: any_srclexer -> (text -> 'a -> 'a) -> 'a -> 'a +val print_source_lines: Format.formatter -> any_srclexer -> unit + +(* --- *) + +type state + +type preproc_phrase = + | Copy of phrase + | Replace of phrase + | Header of tracked_header * phrase +and phrase = + { + prefix: text; + phrase: text; + suffix: text; + } +and tracked_header = + | ControlDivision + | SubstitutionSection + | IdentificationDivision + +val initial_state: state +val find_preproc_phrase + : ?prefix:[ `Rev | `Same ] + -> state + -> text + -> (preproc_phrase * state, + [> `MissingPeriod | `MissingText | `NoneFound ]) result diff --git a/src/lsp/cobol_preproc/preproc_engine.ml b/src/lsp/cobol_preproc/preproc_engine.ml new file mode 100644 index 000000000..0306db49b --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_engine.ml @@ -0,0 +1,453 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc +open Cobol_common.Srcloc.INFIX +open Cobol_common.Diagnostics.TYPES + +module DIAGS = Cobol_common.Diagnostics + +(* --- *) + +type input = + | Filename of string + | String of { contents: string; filename: string } + | Channel of { contents: in_channel; filename: string } + +let decide_source_format _input + : Cobol_config.source_format_spec -> + Cobol_config.source_format with_diags = function + | SF result -> + { result; diags = DIAGS.Set.none } + | Auto -> + { result = SFFixed; + diags = DIAGS.(Acc.warn Set.none) "Source format `auto` is not supported \ + yet, using `fixed`" } + +(* --- *) + +type log = log_entry list +and rev_log = log +and log_entry = Preproc.log_entry = + { + matched_loc: Cobol_common.Srcloc.srcloc; + replacement_text: Text.text; + } + +(* --- *) + +type preprocessor = + { + buff: Text.text; + srclex: Preproc.any_srclexer; + ppstate: Preproc.state; + pplog: Preproc.log; + diags: DIAGS.diagnostics; + persist: preprocessor_persist; + } +and preprocessor_persist = + (** the preprocessor state that does not change very often *) + { + pparser: (module Preproc.PPPARSER); + overlay_manager: (module Src_overlay.MANAGER); + config: Cobol_config.t; + replacing: Preproc.replacing with_loc list list; + copybooks: COPYLOCS.t; (* opened copybooks *) + libpath: string list; + verbose: bool; + show_if_verbose: [`Txt | `Src] list; + } + +let diags { diags; srclex; _ } = + DIAGS.Set.union diags @@ Preproc.srclex_diags srclex +let add_diag lp d = { lp with diags = DIAGS.Set.cons d lp.diags } +let add_diags lp d = { lp with diags = DIAGS.Set.union d lp.diags } +let log { pplog; _ } = List.rev pplog +let rev_log { pplog; _ } = pplog +let srclexer { srclex; _ } = srclex +let position { srclex; _ } = Preproc.srclex_pos srclex + +let with_srclex lp srclex = + if lp.srclex == srclex then lp else { lp with srclex } +let with_diags lp diags = + if lp.diags == diags then lp else { lp with diags } +let with_buff lp buff = + if lp.buff == buff then lp else { lp with buff } +let with_pplog lp pplog = + if lp.pplog == pplog then lp else { lp with pplog } +let with_buff_n_pplog lp buff pplog = + if lp.buff == buff && lp.pplog == pplog then lp else { lp with buff; pplog } +let with_replacing lp replacing = + { lp with persist = { lp.persist with replacing } } + +let show tag { persist = { verbose; show_if_verbose; _ }; _ } = + verbose && List.mem tag show_if_verbose + +let make_srclex ?(on_period_only = true) ~source_format = function + | Filename filename -> + Preproc.srclex_from_file on_period_only ~source_format filename + | String { contents; filename } -> + Preproc.srclex_from_string on_period_only ~filename ~source_format contents + | Channel { contents; filename } -> + Preproc.srclex_from_channel on_period_only ~filename ~source_format contents + +type init = + { + init_libpath: string list; + init_config: Cobol_config.t; + init_source_format: Cobol_config.source_format_spec; + } + +let preprocessor ?(on_period_only = true) ?(verbose = false) input = function + | `WithLibpath { init_libpath = libpath; + init_config = (module Config); + init_source_format = source_format; } -> + let module Om_name = struct let name = __MODULE__ end in + let module Om = Src_overlay.New_manager (Om_name) in + let module Pp = Preproc_grammar.Make (Config) (Om) in + let { result = source_format; diags } + = decide_source_format input source_format in + { + buff = []; + srclex = make_srclex ~on_period_only ~source_format input; + ppstate = Preproc.initial_state; + pplog = []; + diags = diags; + persist = + { + pparser = (module Pp); + overlay_manager = (module Om); + config = (module Config); + replacing = []; + copybooks = COPYLOCS.none; + libpath; + verbose; + show_if_verbose = [`Src]; + }; + } + | `Fork ({ persist; _ } as from, copyloc, copybook) -> + let source_format = Preproc.srclex_source_format from.srclex in + { + from with + buff = []; + srclex = make_srclex ~source_format input; + persist = + { + persist with + copybooks = COPYLOCS.append ~copyloc copybook persist.copybooks; + verbose = persist.verbose || verbose; + }; + } + +(* --- *) + +let apply_active_replacing { pplog; persist; _ } = match persist with + | { replacing = r :: _; _ } -> Preproc.apply_replacing OnPartText r pplog + | _ -> fun text -> Ok (text, pplog) + +let apply_active_replacing_full { pplog; persist; _ } = match persist with + | { replacing = r :: _; _ } -> Preproc.apply_replacing OnFullText r pplog + | _ -> fun text -> text, pplog + +(** [next_sentence lp] reads the next sentence from [lp], handling lexical and + compiler directives along the way. It never returns an empty sentence: the + output text always terminates with a period or {!Eof}. *) +let rec next_sentence ({ srclex; buff; _ } as lp) = + match Preproc.next_source_line srclex with + | srclex, ([{ payload = Eof; _}] as eof) -> + let text, pplog = apply_active_replacing_full lp (buff @ eof) in + text, { lp with srclex; pplog; buff = [] } + | srclex, text -> + if show `Src lp then + Pretty.error "Src: %a@." Text.pp_text text; + match try_lexing_directive (with_srclex lp srclex) text with + | Ok lp -> + next_sentence lp + | Error `NotLexDir -> + preprocess_line { lp with srclex; buff = [] } (buff @ text) + +and try_lexing_directive ({ persist = { pparser = (module Pp); + overlay_manager = om; _ }; + srclex; _ } as lp) srctext = + match Text_supplier.supply_text_if_compiler_directive om srctext with + | Error `NotCDir -> + Error `NotLexDir + | Ok supplier -> + let parser = Pp.Incremental.lexing_directive (position lp) in + match ~&(Pp.MenhirInterpreter.loop supplier parser) with + | { result = Some LexDirSource sf; diags } -> + let lp = add_diags lp diags in + Ok (with_srclex lp (Preproc.with_source_format sf srclex)) + | { result = None; diags } -> (* valid lexdir with erroneous semantics *) + Ok (add_diags lp diags) + | exception Pp.Error -> + let loc = Cobol_common.Srcloc.concat_locs srctext in + Ok (DIAGS.Cont.kerror (add_diag lp) ?loc + "Malformed@ or@ unknown@ compiler@ directive") + +and preprocess_line lp srctext = + match try_preproc lp srctext with + | Ok (`CDirNone (lp, [])) -> (* Never return empty: skip to next sentence *) + next_sentence lp + | Ok (`CDirNone (lp, text)) -> + do_replacing lp text + | Ok (`CopyDone (lp, srctext)) + | Ok (`ReplaceDone (lp, [], srctext)) + | Ok (`CDirDone (lp, srctext)) -> (* Continue with next phrase, which may also + be a compiler directive. *) + preprocess_line lp srctext + | Ok (`ReplaceDone (lp, text, srctext)) -> + text, with_buff lp srctext + | Error (`MissingPeriod | `MissingText) -> + next_sentence (with_buff lp srctext) + +and do_replacing lp text = + match apply_active_replacing lp text with + | Ok (text, pplog) -> + text, with_pplog lp pplog + | Error (`MissingText ([], pplog, buff)) -> + next_sentence (with_buff_n_pplog lp buff pplog) + | Error (`MissingText (text, pplog, buff)) -> + text, with_buff_n_pplog lp buff pplog + +and try_preproc lp srctext = + match Preproc.find_preproc_phrase ~prefix:`Rev lp.ppstate srctext with + | Error (`MissingPeriod | `MissingText) as e -> e + | Error `NoneFound -> Ok (`CDirNone (lp, srctext)) + | Ok (cdir, ppstate) -> Ok (process_preproc_phrase { lp with ppstate } cdir) + +and process_preproc_phrase ({ persist = { pparser = (module Pp); + overlay_manager = (module Om); + config = (module Config); _ }; + _ } as lp) = + let parse ~stmt parser phrase : _ result = + Pp.MenhirInterpreter.loop_handle + Result.ok + (function + | HandlingError env -> + let loc = Om.join_limits @@ Pp.MenhirInterpreter.positions env in + Error DIAGS.(Set.one @@ + One.error ~loc "Malformed@ %s@ statement" stmt) + | _ -> + Pretty.failwith + "Unexpected@ state@ of@ parser@ for@ %s@ statement" stmt) + (Text_supplier.pptoks_of_text_supplier (module Om) phrase) + (parser @@ position lp) + in + function + | Copy { prefix = rev_prefix; phrase; suffix } -> + Result.fold (parse ~stmt:"COPY" Pp.Incremental.copy_statement phrase) + ~ok:(fun copy -> do_copy lp rev_prefix copy suffix) + ~error:(fun diags -> `CopyDone (add_diags lp diags, + List.rev_append rev_prefix suffix)) + | Replace { prefix = rev_prefix; phrase; suffix } -> + Result.fold (parse ~stmt:"REPLACE" Pp.Incremental.replace_statement phrase) + ~ok:(fun repl -> do_replace lp rev_prefix repl suffix) + ~error:(fun diags -> `ReplaceDone (add_diags lp diags, + List.rev rev_prefix, suffix)) + | Header (header, { prefix = rev_prefix; phrase; suffix }) -> + let prefix = match header with + | ControlDivision + | IdentificationDivision -> + (* keep phrases that are further syntax-checked by the parser, and + used to perform dialect-related checks there. *) + List.rev_append rev_prefix phrase + | SubstitutionSection -> + (* discard this phrase, which is not checked by the parser *) + List.rev rev_prefix + in + `ReplaceDone (lp, prefix, suffix) + +and do_copy lp rev_prefix copy suffix = + let { result = CDirCopy { library; replacing; _ }; diags } = ~© in + let lp = add_diags lp diags in + let libtext, lp = read_lib lp ~@copy library in + let libtext, pplog = + Preproc.apply_replacing OnFullText replacing lp.pplog libtext + in + let lp = with_pplog lp pplog in + (* eprintf "Library text: %a@." pp_text libtext; *) + let text = List.rev_append rev_prefix libtext @ suffix in + `CopyDone (lp, text) + +and do_replace lp rev_prefix repl suffix = + let { result = repl; diags } = ~&repl in + let lp = add_diags lp diags in + let prefix, pplog = + (* NB: this applies the current replacing on all remaining text leading to + the current replacing phrase ([rev_prefix]), so this assumes no replacing + may be performed on text that starts before and terminates after the + replacing phrase. *) + apply_active_replacing_full lp @@ List.rev rev_prefix + in + let lp = with_pplog lp pplog in + let lp = match repl, lp.persist.replacing with + | CDirReplace { replacing = repl; _ }, ([] as replacing) + | CDirReplace { replacing = repl; also = false }, replacing -> + with_replacing lp (repl :: replacing) + | CDirReplace { replacing = repl; also = true }, (r :: _ as replacing) -> + with_replacing lp ((repl @ r) :: replacing) + | CDirReplaceOff _, [] + | CDirReplaceOff { last = false }, _ -> + with_replacing lp [] + | CDirReplaceOff { last = true }, (_ :: replacing) -> + with_replacing lp replacing + in + `ReplaceDone (lp, prefix, suffix) + + +and read_lib ({ diags; persist = { libpath; copybooks; verbose; _ }; _ } as lp) + loc { libname; cbkname } = + let libpath = match ~&?cbkname with None -> libpath | Some (_, d) -> [d] in + let text, diags = match Copybook.find_lib ~libpath ~&libname with + | Ok filename when COPYLOCS.mem filename copybooks -> + (* TODO: `note addendum *) + [], + DIAGS.Acc.error diags ~loc "@[Cyclic@ COPY@ of@ `%s'@]" filename + | Ok filename -> + if verbose then + Pretty.error "Reading library `%s'@." filename; + let text, pp' = + full_text + (preprocessor (Filename filename) (`Fork (lp, loc, filename))) + ~postproc:(Cobol_common.Srcloc.copy_from ~filename ~copyloc:loc) + in + text, pp'.diags + | Error lnf -> + [], + Copybook.lib_not_found_error (DIAGS.Acc.error diags ~loc "%t") lnf + in + text, with_diags lp diags + +and full_text ?(item = "library") ?postproc lp : Text.text * preprocessor = + let eofp p = ~&p = Text.Eof in + let rec aux acc lp = + let text, lp = next_sentence lp in + let text = match postproc with + | None -> text + | Some p -> List.(rev @@ rev_map p text) + in + if not (List.exists eofp text) + then aux (text :: acc) lp + else begin + if lp.persist.verbose then + Pretty.error "Reached end of %s@." item; + List.(concat (rev (filter (fun p -> not(eofp p)) text :: acc))), lp + end + in + aux [] lp + +let next_sentence lp = + let text, lp = next_sentence lp in + if show `Txt lp then + Pretty.error "Txt: %a@." Text.pp_text text; + text, lp + +(* Pre-processing *) + +(** For now, pre-processor tokens are essentially the same tokens as the general + compilation group tokens since we reuse the same parser module. *) +type pptoken = Preproc_tokens.token with_loc + +[@@@warning "-34"] +type pptokens = pptoken list + +let pp_pptoken ppf (t: pptoken) = + let t = ~&t in + try Pretty.string ppf (Hashtbl.find Src_lexer.keyword_of_pptoken t) + with Not_found -> match t with + | TEXT_WORD w -> Pretty.print ppf "TEXT_WORD[%s]" w + | PSEUDO_TEXT t -> Text.pp_pseudotext ppf t + | ALPHANUM (s, q) -> Pretty.print ppf "%a%s%a" Text.pp_quote q s Text.pp_quote q + | NATLIT s -> Pretty.print ppf "N\"%s\"" s + | BOOLIT s -> Pretty.print ppf "B\"%s\"" s + | HEXLIT s -> Pretty.print ppf "X\"%s\"" s + | NULLIT s -> Pretty.print ppf "Z\"%s\"" s + | LPAR -> Pretty.char ppf '(' + | RPAR -> Pretty.char ppf ')' + | PERIOD -> Pretty.char ppf '.' + | EOL -> Pretty.string ppf "EOL" +(* +Here is an example of a case that is not matched: +(TRAILING|SUPPRESS|SOURCEFORMAT|REPLACING|REPLACE|PRINTING|OFF|OF|LEADING| +LAST|IS|IN|FREE|FORMAT|COPY|CDIR_SOURCE|CDIR_SET|BY|ALSO|ALPHANUM_PREFIX _) +*) + | _ -> Pretty.string ppf "" + +[@@@warning "-32"] (* unused *) +let pp_pptokens: pptokens Pretty.printer = + Pretty.list ~fopen:"@[" ~fclose:"@]" pp_pptoken + +(* --- *) + +(** Default pretty-printing formatter for {!lex_file}, {!lex_lib}, and + {!preprocess_file}. *) +let default_oppf = Fmt.stdout + +let lex_file ?(on_period_only = true) ~source_format ?(ppf = default_oppf) = + Cobol_common.do_unit begin fun (module DIAGS) filename -> + let source_format = + DIAGS.grab_diags @@ decide_source_format filename source_format in + let pl = Preproc.srclex_from_file on_period_only ~source_format filename in + Preproc.print_source_lines ppf pl + end + +let lex_lib ?(on_period_only = true)~source_format ~libpath ?(ppf = default_oppf) = + Cobol_common.do_unit begin fun (module DIAGS) libname -> + match Copybook.find_lib ~libpath libname with + | Ok filename -> + let source_format = + DIAGS.grab_diags @@ decide_source_format filename source_format in + let pl = Preproc.srclex_from_file on_period_only ~source_format filename in + Preproc.print_source_lines ppf pl + | Error lnf -> + Copybook.lib_not_found_error (DIAGS.error "%t") lnf + end + +(* TODO: get rid of `on_period_only` *) +let fold_text_lines ?(on_period_only = true) ~source_format ?epf f = + Cobol_common.do_any ?epf begin fun (module DIAGS) filename -> + let source_format = + DIAGS.grab_diags @@ decide_source_format filename source_format in + let lex = Preproc.srclex_from_file on_period_only ~source_format filename in + Preproc.(fold_source_lines lex) f + end + +let pp_preprocessed ppf lp = + Pretty.print ppf "%a@." Text.pp_text (fst @@ full_text ~item:"file" lp) + +let preprocess_file ~source_format ?verbose ?(config = Cobol_config.default) + ~libpath ?(ppf = default_oppf) = + let preprocessor = preprocessor ?verbose in + Cobol_common.do_unit begin fun _init_diags filename -> + pp_preprocessed ppf @@ preprocessor (Filename filename) @@ + `WithLibpath { init_libpath = libpath; + init_config = config; + init_source_format = source_format} + end + +let text_of_input ~source_format ?verbose ?(config = Cobol_config.default) + ~libpath ?epf a = + let preprocessor = preprocessor ?verbose in + Cobol_common.do_any begin fun _init_diags input -> + fst @@ + full_text ~item:"file" @@ + preprocessor input @@ + `WithLibpath { init_libpath = libpath; + init_config = config; + init_source_format = source_format} + end ?epf a + +let text_of_file ~source_format ?verbose ?(config = Cobol_config.default) + ~libpath ?epf filename = + text_of_input ~source_format ?verbose ~config ~libpath ?epf (Filename filename) diff --git a/src/lsp/cobol_preproc/preproc_engine.mli b/src/lsp/cobol_preproc/preproc_engine.mli new file mode 100644 index 000000000..7b59810f4 --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_engine.mli @@ -0,0 +1,113 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +type preprocessor + +type input = + | Filename of string + | String of { contents: string; filename: string } + | Channel of { contents: in_channel; filename: string } + +type init = + { + init_libpath: string list; + init_config: Cobol_config.t; + init_source_format: Cobol_config.source_format_spec; + } + +type log = log_entry list +and rev_log = log +and log_entry = Preproc.log_entry = + { + matched_loc: Cobol_common.Srcloc.srcloc; + replacement_text: Text.text; + } + +(* --- *) + +val diags: preprocessor -> Cobol_common.Diagnostics.Set.t +val add_diag: preprocessor -> Cobol_common.Diagnostics.t -> preprocessor +val add_diags: preprocessor -> Cobol_common.Diagnostics.Set.t -> preprocessor +val log: preprocessor -> log +val rev_log: preprocessor -> rev_log +val srclexer: preprocessor -> Preproc.any_srclexer +val position: preprocessor -> Lexing.position +val next_sentence: preprocessor -> Text.text * preprocessor + +(** {2 High-level commands} *) + +val decide_source_format + : string + -> Cobol_config.source_format_spec + -> Cobol_config.source_format Cobol_common.Diagnostics.with_diags + +val preprocessor + : ?on_period_only:bool + -> ?verbose:bool + -> input + -> [< `WithLibpath of init ] + -> preprocessor + +val lex_file + : ?on_period_only:bool + -> source_format: Cobol_config.source_format_spec + -> ?ppf:Format.formatter + -> ?epf:Format.formatter + -> string + -> unit + +val fold_text_lines + : ?on_period_only:bool + -> source_format: Cobol_config.source_format_spec + -> ?epf:Format.formatter + -> (Text.text -> 'a -> 'a) + -> string + -> 'a + -> 'a + +val lex_lib + : ?on_period_only:bool + -> source_format: Cobol_config.source_format_spec + -> libpath:string list + -> ?ppf:Format.formatter + -> ?epf:Format.formatter + -> [< `Alphanum | `Word ] * string + -> unit + +val preprocess_file + : source_format: Cobol_config.source_format_spec + -> ?verbose:bool + -> ?config:Cobol_config.t + -> libpath:string list + -> ?ppf:Format.formatter + -> ?epf:Format.formatter + -> string + -> unit + +val text_of_file + : source_format: Cobol_config.source_format_spec + -> ?verbose:bool + -> ?config:Cobol_config.t + -> libpath:string list + -> ?epf:Format.formatter + -> string + -> Text.text + +val text_of_input + : source_format: Cobol_config.source_format_spec + -> ?verbose:bool + -> ?config:Cobol_config.t + -> libpath:string list + -> ?epf:Format.formatter + -> input + -> Text.text diff --git a/src/lsp/cobol_preproc/preproc_grammar.mly b/src/lsp/cobol_preproc/preproc_grammar.mly new file mode 100644 index 000000000..c28c1735a --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_grammar.mly @@ -0,0 +1,177 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2022 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) + +%parameter +%parameter +%{ + open CONFIG + open Preproc_utils.Make (CONFIG) + open Cobol_common.Srcloc.INFIX + open Cobol_common.Diagnostics.TYPES +%} + +(* Tokens are listed in `preproc_tokens.mly' *) + +(* Entry points *) + +%start lexing_directive +%start copy_statement +%start replace_statement + +%start _unused_symbols (* <- used to supress some warnings *) + +(* -------------------------------------------------------------------------- *) + +%% + +(* --------------------- DEDICATED UTILITIES -------------------------------- *) + +let loc (X) == + | x = X; { x &@ Overlay_manager.join_limits $sloc } + +(* --- Entry points --------------------------------------------------------- *) + +let lexing_directive := + | ~ = lexdir_phrase; option("."); EOL; < > + | ~ = lexdir_microfocus_phrase; EOL; < > + +let lexdir_phrase := + | ~ = loc(lexdir_source_format); < > + +let lexdir_microfocus_phrase := + | ~ = loc(lexdir_microfocus_sourceformat); < > + +(* --- >>SOURCE | $ SET SOURCEFORMAT ---------------------------------------- *) + +let lexdir_source_format := + | CDIR_SOURCE; FORMAT?; IS?; _free = loc(FREE); + { let SF sf = Src_lexing.select_source_format Cobol_config.SFFree in + Cobol_common.Diagnostics.some_result @@ + Preproc.LexDirSource (sf &@<- _free) } + | CDIR_SOURCE; FORMAT?; IS?; i = text_word; + { Preproc.cdir_source_format ~dialect i } + +let lexdir_microfocus_sourceformat := + | CDIR_SET; SOURCEFORMAT; i = loc(ALPHANUM); (* elementary_string_literal? *) + { Preproc.cdir_source_format ~dialect (Cobol_common.Srcloc.locmap fst i) } + +(* --- COPY ----------------------------------------------------------------- *) + +let copy_statement := ~ = loc (copy_statement_); EOL; < > +let copy_statement_ := + | COPY; + l = copy_lib; + sp = copy_suppress_printing; + replacing = copy_replacings; + "."; + { let { result = replacing; diags } + = filter_map_4_list_with_diags' replacing in + { result = CDirCopy { library = l; suppress_printing = sp; replacing }; + diags } } + +let copy_lib := + | l = fileloc; c = pf(or_(OF, IN),fileloc)?; { { libname = l; cbkname = c } } + +let copy_suppress_printing := + | { false } + | SUPPRESS; PRINTING?; { true } + +let copy_replacings := + | { [] } + | REPLACING; ~ = nell(loc(copy_replacing_clause)); < > + +let copy_replacing_clause == + | repl_from = copy_replacing_text; BY; + repl_to = copy_replacing_text; + { Preproc.replacing repl_from repl_to } + | repl_dir = leading_or_trailing; + repl_from = loc(replacing_src); BY; + repl_to = loc(replacing_dst); + { replacing' ~repl_dir repl_from repl_to } + +let replacing_src := + | ~ = PSEUDO_TEXT; <`PseudoText> + | a = loc(ALPHANUM); {`Alphanum [ Text.alphanum_as_pseudoword a ]} + +let replacing_dst := + | ~ = PSEUDO_TEXT; < > + | a = loc(ALPHANUM); {[ Text.alphanum_as_pseudoword a ]} + +let copy_replacing_text == + | ~ = loc(PSEUDO_TEXT); < > + | ~ = loc(copy_replacing_text_identifier); < > + +let copy_replacing_text_token == + | t = loc(ALPHANUM); { Text.pseudoword_of_alphanum t } + | t = loc(TEXT_WORD); { Text.pseudoword_of_string t } + +let copy_replacing_text_identifier := + | c = copy_replacing_text_token; + { [c] } + | c = copy_replacing_text_identifier; _in = loc(IN); tok = copy_replacing_text_token; + { c @ [Text.pseudoword_of_string ("IN" &@<- _in); tok] } + | c = copy_replacing_text_identifier; _of = loc(OF); tok = copy_replacing_text_token; + { c @ [Text.pseudoword_of_string ("OF" &@<- _of); tok] } + | c = copy_replacing_text_identifier; + _lpar = loc("("); cl = copy_replacing_text_token+; _rpar = loc(")"); + { let lpar = Text.pseudoword_of_string ("(" &@<- _lpar) + and rpar = Text.pseudoword_of_string (")" &@<- _rpar) in + c @ [lpar] @ cl @ [rpar] } + +let leading_or_trailing := + | LEADING; { Cobol_common.Srcloc.Leading } + | TRAILING; { Cobol_common.Srcloc.Trailing } + +(* --- REPLACE -------------------------------------------------------------- *) + +let replace_statement := ~ = loc(replace_statement_); EOL; < > +let replace_statement_ := + | REPLACE; also = ibo(ALSO); replacing = nell(loc(copy_replacing_clause)); "."; + { let { result = replacing; diags } + = filter_map_4_list_with_diags' replacing in + { result = CDirReplace { also; replacing }; diags } } + | REPLACE; last = ibo(LAST); OFF; "."; + { Cobol_common.Diagnostics.simple_result @@ + Preproc.CDirReplaceOff { last } } + +(* ISO/IEC 1989:2014 only allows the following clauses in "REPLACE"; however we + allow the same clauses as GnuCOBOL. *) +(* let replace_clause := *) +(* | repl_dir = leading_or_trailing?; *) +(* repl_from = loc(replacing_src); BY; *) +(* repl_to = loc(replacing_dst); *) +(* { replacing' ?repl_dir repl_from repl_to } *) + +let text_word := (* text-word with position *) + | ~ = loc(TEXT_WORD); < > + +let fileloc := + | t = text_word; { (`Word, ~&t) &@<- t } + | a = loc(ALPHANUM); { (`Alphanum, fst ~&a) &@<- a } + +(* --- Misc ----------------------------------------------------------------- *) + +_unused_symbols: + | BOOLIT + | NATLIT + | HEXLIT + | NULLIT + | ALPHANUM_PREFIX +{ () } + +%% diff --git a/src/lsp/cobol_preproc/preproc_grammar_sig.ml b/src/lsp/cobol_preproc/preproc_grammar_sig.ml new file mode 100644 index 000000000..29a209516 --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_grammar_sig.ml @@ -0,0 +1,67 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* Interface of the module generated by preproc_grammar.mly *) + +module type S = sig + (* From _build/default/src/cobol_preproc/preproc_grammar.mli *) + + module Make + (CONFIG: Cobol_config.T) + (Overlay_manager: Src_overlay.MANAGER) + : sig + + (* The type of tokens. *) + + type token = Preproc_tokens.token + + (* This exception is raised by the monolithic API functions. *) + + exception Error + + (* The monolithic API. *) + + val replace_statement: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Preproc.replace_statement Cobol_common.Srcloc.with_loc) + + val lexing_directive: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Preproc.lexing_directive Cobol_common.Srcloc.with_loc) + + val copy_statement: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Preproc.copy_statement Cobol_common.Srcloc.with_loc) + + val _unused_symbols: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (unit) + + module MenhirInterpreter : sig + + (* The incremental API. *) + + include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE + with type token = token + + end + + (* The entry point(s) to the incremental API. *) + + module Incremental : sig + + val replace_statement: Lexing.position -> (Preproc.replace_statement Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint + + val lexing_directive: Lexing.position -> (Preproc.lexing_directive Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint + + val copy_statement: Lexing.position -> (Preproc.copy_statement Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint + + val _unused_symbols: Lexing.position -> (unit) MenhirInterpreter.checkpoint + + end + + end + +end diff --git a/src/lsp/cobol_preproc/preproc_keywords.ml b/src/lsp/cobol_preproc/preproc_keywords.ml new file mode 100644 index 000000000..14411fa4a --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_keywords.ml @@ -0,0 +1,31 @@ +(* Caution: this file was automatically generated from preproc_grammar.cmly; do not edit *) +[@@@warning "-33"] (* <- do not warn on unused opens *) + +let keywords = Preproc_tokens.[ + "TRAILING", TRAILING; + "SUPPRESS", SUPPRESS; + "SOURCEFORMAT", SOURCEFORMAT; + "REPLACING", REPLACING; + "REPLACE", REPLACE; + "PRINTING", PRINTING; + "OFF", OFF; + "OF", OF; + "LEADING", LEADING; + "LAST", LAST; + "IS", IS; + "IN", IN; + "FREE", FREE; + "FORMAT", FORMAT; + "COPY", COPY; + ">>SOURCE", CDIR_SOURCE; + ">>SET", CDIR_SET; + "BY", BY; + "ALSO", ALSO; +] + +let puncts = Preproc_tokens.[ +] + +let silenced_keywords = Preproc_tokens.[ +] + diff --git a/src/lsp/cobol_preproc/preproc_tokens.mly b/src/lsp/cobol_preproc/preproc_tokens.mly new file mode 100644 index 000000000..6ff7c7279 --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_tokens.mly @@ -0,0 +1,50 @@ +%{ +(**************************************************************************) +(* *) +(* Copyright (c) 2022 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the GNU Lesser General *) +(* Public License version 2.1, with the special exception on linking *) +(* described in the LICENSE.md file in the root directory. *) +(* *) +(* *) +(**************************************************************************) +%} + +%token EOL +%token TEXT_WORD (* Words before text manipulation stage. For + compiler_directive *) +%token ALPHANUM +%token ALPHANUM_PREFIX +%token NATLIT +%token BOOLIT +%token HEXLIT +%token NULLIT +%token PSEUDO_TEXT + +%token LPAR "(" +%token PERIOD "." +%token RPAR ")" + +%token ALSO [@keyword] +%token BY [@keyword] +%token CDIR_SET [@keyword ">>SET"] +%token CDIR_SOURCE [@keyword ">>SOURCE"] +%token COPY [@keyword] +%token FORMAT [@keyword] +%token FREE [@keyword] (* +COB2002 *) +%token IN [@keyword] +%token IS [@keyword] +%token LAST [@keyword] +%token LEADING [@keyword] +%token OF [@keyword] +%token OFF [@keyword] +%token PRINTING [@keyword] +%token REPLACE [@keyword] +%token REPLACING [@keyword] +%token SOURCEFORMAT [@keyword] +%token SUPPRESS [@keyword] (* +COB85 *) +%token TRAILING [@keyword] + +%% diff --git a/src/lsp/cobol_preproc/preproc_utils.ml b/src/lsp/cobol_preproc/preproc_utils.ml new file mode 100644 index 000000000..9b09b03e8 --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_utils.ml @@ -0,0 +1,62 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX +open Cobol_common.Diagnostics.TYPES +module DIAGS = Cobol_common.Diagnostics + +module Make (Config: Cobol_config.T) = struct + + let safe_partial_replacing_when_src_literal ~loc = + Config.safe_partial_replacing_when_src_literal#verify' ~loc:(Some loc) |> + DIAGS.map_result (function Some s -> s = `Safe | None -> false) + + let replacing' ?repl_dir repl_from repl_to = + match repl_dir, ~&repl_from with + | None, (`PseudoText src | `Alphanum src) -> + Preproc.replacing (src &@<- repl_from) repl_to + | Some repl_dir, `PseudoText src -> + Preproc.replacing ~partial:{ repl_dir; repl_strict = false } + (src &@<- repl_from) repl_to + | Some repl_dir, `Alphanum src -> + let { result = repl_strict; diags } = + let loc = ~@repl_to in + match ~&repl_to with + | [{ payload = PseudoWord [{ payload = PwText str; _ }]; _ }] + when str = "" -> + safe_partial_replacing_when_src_literal ~loc + | [{ payload = PseudoWord [{ payload = PwText str; _ }]; _ }] + when String.contains str ' ' || (* TODO: properly check spaces *) + String.contains str '\t' -> (* reject *) + DIAGS.error_result false ~loc "Forbidden@ operand@ with@ spaces" + | [{ payload = PseudoWord (_::_::_); _ }] | _::_::_ -> + DIAGS.error_result false ~loc "Forbidden@ multi-word@ operand" + | _ -> + DIAGS.result false + in + DIAGS.with_more_diags ~diags @@ + Preproc.replacing ~partial:{ repl_dir; repl_strict } + (src &@<- repl_from) repl_to + + let filter_map_4_list_with_diags' + : 'a option with_diags with_loc list -> 'a with_loc list with_diags = fun l -> + List.fold_left begin fun (result, diags) { payload = { result = r; diags = d }; + loc } -> + (match r with None -> result | Some r -> (r &@ loc) :: result), + DIAGS.Set.union diags d + end ([], DIAGS.Set.none) l |> + fun (result, diags) -> { result = List.rev result; diags } + + +end diff --git a/src/lsp/cobol_preproc/preproc_utils.mli b/src/lsp/cobol_preproc/preproc_utils.mli new file mode 100644 index 000000000..6277dbb27 --- /dev/null +++ b/src/lsp/cobol_preproc/preproc_utils.mli @@ -0,0 +1,29 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Diagnostics.TYPES + +module Make (Config: Cobol_config.T) : sig + + val replacing' + : ?repl_dir:Cobol_common.Srcloc.leading_or_trailing + -> [< `Alphanum of Text.pseudotext + | `PseudoText of Text.pseudotext ] Cobol_common.Srcloc.with_loc + -> Text.pseudotext Cobol_common.Srcloc.with_loc + -> Preproc.replacing option Cobol_common.Diagnostics.with_diags + + val filter_map_4_list_with_diags' + : 'a option with_diags with_loc list -> 'a with_loc list with_diags + +end diff --git a/src/lsp/cobol_preproc/src_lexer.mli b/src/lsp/cobol_preproc/src_lexer.mli new file mode 100644 index 000000000..5ae512ddb --- /dev/null +++ b/src/lsp/cobol_preproc/src_lexer.mli @@ -0,0 +1,25 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* First lexer *) + +val line: ('k Src_lexing.state as 's) -> Lexing.lexbuf -> 's * Text.text + +(* Second lexer *) + +val keyword_of_pptoken: (Preproc_tokens.token, string) Hashtbl.t + +type pptoken_component = + | PPTok of Preproc_tokens.token + | PPEnd +val pptoken: Lexing.lexbuf -> pptoken_component diff --git a/src/lsp/cobol_preproc/src_lexer.mll b/src/lsp/cobol_preproc/src_lexer.mll new file mode 100644 index 000000000..745896dd2 --- /dev/null +++ b/src/lsp/cobol_preproc/src_lexer.mll @@ -0,0 +1,528 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +{ + (* Two lexers: + * `line`: for lines of code before preprocessing + * `pptoken`: for simple tokens in the middle of preprocessing + *) + + let pptoken_of_keyword = Hashtbl.create 15 + let keyword_of_pptoken = Hashtbl.create 15 + let __init_keywords = + List.iter begin fun (kwd, token) -> + Hashtbl.add keyword_of_pptoken token kwd; + Hashtbl.add pptoken_of_keyword kwd token; + end Preproc_keywords.keywords + + let update_loc lexbuf file line absolute chars = + let open Lexing in + let pos = lexbuf.lex_curr_p in + let new_file = match file with + | None -> pos.pos_fname + | Some s -> s + in + lexbuf.lex_curr_p <- + { pos with + pos_fname = new_file; + pos_lnum = if absolute then line else pos.pos_lnum + line; + pos_bol = pos.pos_cnum - chars } + + type pptoken_component = + | PPTok of Preproc_tokens.token + | PPEnd + +} + +let newline = '\r'* '\n' +let nnl = _ # ['\r' '\n'] (* anything but newline *) +let sna = nnl nnl nnl nnl nnl nnl (* 6 chars *) +let spaces = ([' ' '\t']*) +let blank = [' ' '\009' '\r'] +let nonblank = nnl # blank +let blanks =(blank+ | '\t') +let blank_area_A = blank blank blank blanks | '\t' +let nonblank_area_A =(nonblank nnl nnl nnl | + blank nonblank nnl nnl | + blank blank nonblank nnl | + blank blank blank nonblank) +let nonblank = nonblank # ['\t'] (* now, also exclude tab from blank chars *) +let separators = ([ ',' ';' ]+) +let epsilon = "" +let letter = [ 'a'-'z' 'A'-'Z' ] (* TODO: '\128'-'\255'? *) +let digit = [ '0'-'9' ] +let sign = [ '+' '-' ] +let opers = sign | ['*' '/' '>' '<' '=' '&'] | "**" | "::" | ">=" | "<=" | "<>" + +let line_directive_prefix = '#' blanks* "line" spaces +let line_directive_filename = ("\"" ([^ '\r' '\n' '\"' ] * as name) "\"") + +let symbolic_ebcdics = + (digit (digit|','|' ')*) +let alphanum_lit_content_spl = + ((nnl # ['\'']) | ('\'' symbolic_ebcdics '\'') | ("''")) +let alphanum_lit_content_dbl = + ((nnl # [ '"']) | ('"' symbolic_ebcdics '"') | ('"' '"')) +let alphanum_lit_suffix_spl = + (('\'' | "'-")? | '\'' symbolic_ebcdics) +let alphanum_lit_suffix_dbl = + (('"' | "\"-")? | '"' symbolic_ebcdics) +let alphanum_lit = + (* allow zero-length, even if length >= 1 byte according to spec *) + (('\'' alphanum_lit_content_spl* alphanum_lit_suffix_spl) | + ('"' alphanum_lit_content_dbl* alphanum_lit_suffix_dbl)) +let alphanum_lit_new = (* may lack G & GX still *) + ((['B' 'X' 'Z' 'N'] | "BX" | "NX")? alphanum_lit) +let alphanum_lit_cont_double_apostrophes = + ("''" alphanum_lit_content_spl* alphanum_lit_suffix_spl) +let alphanum_lit_cont_double_quotes = + ('"' '"' alphanum_lit_content_dbl* alphanum_lit_suffix_dbl) + +let alphanum_lit_cont_unclosed_ebcdics_double_apostrophes = + ('\'' symbolic_ebcdics + ('\'' alphanum_lit_content_spl*)? alphanum_lit_suffix_spl) +let alphanum_lit_cont_unclosed_ebcdics_double_quotes = + ('"' symbolic_ebcdics + ('"' alphanum_lit_content_dbl*)? alphanum_lit_suffix_dbl) + +let currency_sign_char = (* as per ISO/IEC *) + nonblank # ['0'-'9' + 'A'-'E' 'N' 'P' 'R' 'S' 'V' 'X' 'Z' + 'a'-'e' 'n' 'p' 'r' 's' 'v' 'x' 'z' + ' ' '+' '-' ',' '.' '*' '/' ';' '(' ')' '\'' '"' '='] +let text_char = nonblank # [';' '\'' '"' '=' '<' '>'] +let text_word = (text_char # '*' | '*' (text_char # ['>']))+ | opers + +let cdir_char = + (letter | digit | ':') (* colon for pseudo-words *) +let cdir_word = + (">>" ' '? cdir_char+ ((cdir_char | '_' | '-') cdir_char*)*) + +(* Fixed format *) + +rule fixed_line state + = shortest + | sna ' ' | '\t' (* nominal *) + { + fixed_nominal_line (Src_lexing.flush_continued state) lexbuf + } + | sna '-' (* continuation line *) + { + fixed_continue_line state lexbuf + } + | sna '$' (* microfocus compiler directive *) + { + fixed_cdir_line (Src_lexing.flush_continued state) lexbuf + } + | sna ['*' '/'] (* comment line *) + { + gobble_line state lexbuf + } + | sna ['d' 'D'] + { + fixed_debug_line state lexbuf + } + | sna (_#['\n' '\r'] as c) (* unknown indicator *) + { + Src_lexing.unexpected Char ~c ~knd:"indicator" state lexbuf + ~k:(fun state -> fixed_nominal_line (Src_lexing.flush_continued state)) + } + | (nnl* newline) (* blank line (too short) *) + { + Src_lexing.new_line state lexbuf + } + | (nnl* eof) (* blank line (too short), without newline character *) + { + Src_lexing.(flush @@ eof state lexbuf) + } +and xopen_line state (* X/Open free-form *) + = parse (* (note no continuation line indicator) *) + | "D " + { + fixed_debug_line state lexbuf + } + | epsilon + { + xopen_or_crt_or_acutrm_followup state lexbuf + } +and crt_line state (* ICOBOL Free-form (CRT) *) + = parse + | ['D' 'd'] + { + fixed_debug_line state lexbuf + } + | '-' (* continuation line *) + { + fixed_continue_line state lexbuf + } + | epsilon + { + xopen_or_crt_or_acutrm_followup state lexbuf + } +and acutrm_line state (* ACUCOBOL-GT Terminal (compat with VAX COBOL term.) *) + = parse + | "\\D" + { + fixed_debug_line state lexbuf + } + | '-' (* continuation line *) + { + fixed_continue_line state lexbuf + } + | epsilon + { + xopen_or_crt_or_acutrm_followup state lexbuf + } +and xopen_or_crt_or_acutrm_followup state + = parse + | '$' (* microfocus compiler directive (CHECKME: also for CRT?) *) + { + fixed_cdir_line (Src_lexing.flush_continued state) lexbuf + } + | ['*' '/'] (* comment line *) + { + gobble_line state lexbuf + } + | epsilon + { + fixed_nominal_line (Src_lexing.flush_continued state) lexbuf + } +and cobolx_line state (* COBOLX format (GCOS) *) + = parse + | [' ' '\t'] (* nominal *) + { + fixed_nominal_line (Src_lexing.flush_continued state) lexbuf + } + | '-' (* continuation line *) + { + fixed_continue_line state lexbuf + } + | '$' (* microfocus compiler directive (CHECKME: also for COBOLX?) *) + { + fixed_cdir_line (Src_lexing.flush_continued state) lexbuf + } + | ['*' '/'] (* comment line *) + { + gobble_line state lexbuf + } + | ['D' 'd'] + { + fixed_debug_line state lexbuf + } + | (_#['\n' '\r'] as c) (* unknown indicator *) + { + Src_lexing.unexpected Char ~c ~knd:"indicator" state lexbuf + ~k:(fun state -> fixed_nominal_line (Src_lexing.flush_continued state)) + } + | epsilon + { + newline_or_eof state lexbuf + } +and fixed_debug_line state + = parse + | epsilon + { + let state = Src_lexing.flush_continued state in + if Src_lexing.allow_debug state + then fixed_nominal_line state lexbuf + else gobble_line state lexbuf + } +and fixed_nominal_line state + = parse + | blanks | separators + { + fixed_nominal_line state lexbuf + } + | cdir_word (* CHECKME: does this need to be first item on line? *) + { + Src_lexing.cdir_word ~ktkd:gobble_line ~knom:fixed_nominal state lexbuf + } + | epsilon + { + fixed_nominal state lexbuf + } +and fixed_nominal state + = parse + | blanks | separators + { + fixed_nominal state lexbuf + } + | "*>" nnl* (* floating comment *) + { + gobble_line state lexbuf + } + | "==" + { + Src_lexing.eqeq ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | alphanum_lit_new + { + Src_lexing.alphanum_lit ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | text_word + { + Src_lexing.text_word ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | epsilon + { + newline_or_eof state lexbuf + } +and fixed_cdir_line state (* microfocus compiler directive *) + = parse + | blank text_word (* XXX: '\t'? *) + { + Src_lexing.cdir_word ~ktkd:gobble_line ~knom:fixed_nominal state lexbuf + } + | epsilon + { + newline_or_eof state lexbuf + } +and fixed_continue_line state + = parse + | blank_area_A + { + (* Special rule for double-quoted alphanum continuation and continuation + of literals with unclosed sequences of symbolic EBCDIC characters. + + NB: The ISO/IEC standard is less specific than IBM docs on this. *) + let cont = match Src_lexing.continue_quoted_alphanum state with + | Nominal -> fixed_continue_open + | Closed Quote -> fixed_continue_quoted + | Closed Apostrophe -> fixed_continue_apostrophed + | UnclosedEBCDICs Quote -> fixed_continue_quoted_ebcdics + | UnclosedEBCDICs Apostrophe -> fixed_continue_apostrophed_ebcdics + in + cont state lexbuf + } + | nonblank_area_A + { + Src_lexing.unexpected Str state lexbuf + ~severity:Cobol_common.Diagnostics.Warn + ~knd:"@[non-blank@ area@ A@ on@ continuation@ line@]" + ~k:begin match Src_lexing.continue_quoted_alphanum state with + | Nominal -> fixed_continue_open + | Closed Quote -> fixed_continue_quoted + | Closed Apostrophe -> fixed_continue_apostrophed + | UnclosedEBCDICs Quote -> fixed_continue_quoted_ebcdics + | UnclosedEBCDICs Apostrophe -> fixed_continue_apostrophed_ebcdics + end + } + | epsilon + { + newline_or_eof state lexbuf + } +and fixed_continue_open state + = parse + | alphanum_lit + { + Src_lexing.alphanum_lit ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | text_word + { + Src_lexing.text_word ~cont:true ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | epsilon + { + fixed_nominal state lexbuf + } +and fixed_continue_apostrophed state (* Maybe IBM-specific *) + = parse + | alphanum_lit_cont_double_apostrophes + { + Src_lexing.alphanum_lit ~doubled_opener:true + ~ktkd:gobble_line ~knom:fixed_nominal state lexbuf + } + | epsilon + { + fixed_nominal state lexbuf + } +and fixed_continue_quoted state (* Maybe IBM-specific *) + = parse + | alphanum_lit_cont_double_quotes + { + Src_lexing.alphanum_lit ~doubled_opener:true + ~ktkd:gobble_line ~knom:fixed_nominal state lexbuf + } + | epsilon + { + fixed_nominal state lexbuf + } +and fixed_continue_apostrophed_ebcdics state + = parse + | alphanum_lit_cont_unclosed_ebcdics_double_apostrophes + { + Src_lexing.alphanum_lit ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | epsilon + { + fixed_nominal state lexbuf + } +and fixed_continue_quoted_ebcdics state + = parse + | alphanum_lit_cont_unclosed_ebcdics_double_quotes + { + Src_lexing.alphanum_lit ~ktkd:gobble_line ~knom:fixed_nominal + state lexbuf + } + | epsilon + { + fixed_nominal state lexbuf + } + +(* Free format *) + +and free_line state + = parse + | blanks | '\t' + { + free_line state lexbuf + } + | separators (* Allow separators , & ; at begining of line? *) + { + free_line (Src_lexing.flush_continued ~force:true state) lexbuf + } + | cdir_word + { + Src_lexing.cdir_word' ~k:free_nominal + (Src_lexing.flush_continued ~force:true state) lexbuf + } + | (line_directive_prefix + (['0'-'9']+ as num) spaces line_directive_filename as dir) nnl* + { + match int_of_string num with + | exception _ -> + Pretty.failwith "line number out of range: %s" dir + | line_num -> + update_loc lexbuf (Some name) (line_num - 1) true 0; + free_line state lexbuf + } + | epsilon + { + free_nominal state lexbuf + } +and free_nominal state + = parse + | blanks | separators + { + free_nominal state lexbuf + } + | "*>" nnl* (* floating/inline comment *) + { + free_gobble_line state lexbuf + } + | "==" + { + Src_lexing.eqeq' ~k:free_nominal state lexbuf + } + | alphanum_lit_new + { + Src_lexing.alphanum_lit' ~k:free_nominal state lexbuf + } + | text_word + { + Src_lexing.text_word' ~k:free_nominal state lexbuf + } + | epsilon + { + free_newline_or_eof state lexbuf + } + +(* Common stuff *) + +and gobble_line state + = parse + | (nnl* newline) + { + Src_lexing.new_line state lexbuf + } + | (nnl* eof) + { + Src_lexing.(flush @@ eof state lexbuf) + } +and free_gobble_line state + = parse + | (nnl* newline) + { + Src_lexing.new_line state lexbuf + } + | (nnl* eof) + { + Src_lexing.(flush @@ eof state lexbuf) + } + +and newline_or_eof state + = parse + | newline + { + Src_lexing.new_line state lexbuf + } + | eof + { + Src_lexing.(flush @@ eof state lexbuf) + } + | nnl+ + { + Src_lexing.unexpected Str ~knd:"characters" state lexbuf + ~k:gobble_line + } +and free_newline_or_eof state + = parse + | newline + { + Src_lexing.new_line state lexbuf + } + | eof + { + Src_lexing.(flush @@ eof state lexbuf) + } + | _ + { + Src_lexing.unexpected Char state lexbuf ~k:free_gobble_line + } + +(* Text-word tokenizer (text manipulation statements/replacing clauses) *) +and pptoken = parse + + | blanks + { pptoken lexbuf } + + | '(' { PPTok LPAR } + | ')' { PPTok RPAR } + | '.' { PPTok PERIOD } + + | (([^ '(' ')']+) as s) + { PPTok (try Hashtbl.find pptoken_of_keyword s + with Not_found -> TEXT_WORD s) } + + | eof + { PPEnd } + +(* --- *) + +{ + let line + : type k. k Src_lexing.state -> Lexing.lexbuf -> k Src_lexing.state * _ + = fun s -> match Src_lexing.source_format s with + | _, FreePaging -> free_line s + | XOpenIndic, _ -> xopen_line s + | CRTIndic, _ -> crt_line s + | TrmIndic, _ -> acutrm_line s + | CBLXIndic, _ -> cobolx_line s + | _, FixedWidth _ -> fixed_line s +} diff --git a/src/lsp/cobol_preproc/src_lexing.ml b/src/lsp/cobol_preproc/src_lexing.ml new file mode 100644 index 000000000..a0b3af2f4 --- /dev/null +++ b/src/lsp/cobol_preproc/src_lexing.ml @@ -0,0 +1,676 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Various utilities for pre-processing cobol code into text and pseudo-text *) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX +open Text.TYPES + +module DIAGS = Cobol_common.Diagnostics + +(* --- *) + +let remove_blanks = Str.global_replace (Str.regexp " ") "" (* '\t'? *) + +(* SOURCE FORMAT *) + +(* Paging *) + +type free = | +type fixed = | +type _ paging = + | FreePaging: free paging + | FixedWidth: fixed_paging_params -> fixed paging +and fixed_paging_params = + { + cut_at_col: int; + alphanum_padding: char option; + } + +let fixed_paging = { cut_at_col = 72; alphanum_padding = Some ' ' } +let variable_paging = { fixed_paging with cut_at_col = 250 } +let xcard_paging = { fixed_paging with cut_at_col = 255 } +let xopen_paging = { fixed_paging with cut_at_col = 80 } +let crt_paging = { fixed_paging with cut_at_col = 320 } +let terminal_paging = crt_paging +let cobolx_paging = { cut_at_col = 255; alphanum_padding = None } + +(* Actual format and indicator positioning *) + +type 'k source_format = 'k indicator_position * 'k paging +and _ indicator_position = + | NoIndic: free indicator_position + | FixedIndic: fixed indicator_position + | XOpenIndic: fixed indicator_position + | CRTIndic: fixed indicator_position + | TrmIndic: fixed indicator_position + | CBLXIndic: fixed indicator_position +and any_source_format = + | SF: 'k source_format -> any_source_format [@@unboxed] + +let same_source_formats + : type k r. k source_format -> r source_format -> bool = + fun (i1, p1) (i2, p2) -> match i1, i2 with + | NoIndic, NoIndic -> true + | FixedIndic, FixedIndic -> p1 = p2 + | XOpenIndic, XOpenIndic -> p1 = p2 + | CRTIndic, CRTIndic -> p1 = p2 + | TrmIndic, TrmIndic -> p1 = p2 + | CBLXIndic, CBLXIndic -> p1 = p2 + | _ -> false + +let source_format_spec + : type k. k source_format -> Cobol_config.source_format = function + | NoIndic, _ -> SFFree + | FixedIndic, FixedWidth p when p == fixed_paging -> SFFixed + | FixedIndic, FixedWidth p when p == variable_paging -> SFVariable + | FixedIndic, FixedWidth _ (* when p == xcard_paging *) -> SFxCard + | XOpenIndic, FixedWidth _ (* when p == xopen_paging *) -> SFXOpen + | CRTIndic, FixedWidth _ (* when p == crt_paging *) -> SFCRT + | TrmIndic, FixedWidth _ (* when p == terminal_paging *) -> SFTrm + | CBLXIndic, FixedWidth _ (* when p == cobolx_paging *) -> SFCOBOLX + +let decypher_source_format ~dialect format = + match String.uppercase_ascii @@format, dialect with + (* SOURCEFORMAT"FREE" on MF means: X/Open free format *) + (* cf https://www.microfocus.com/documentation/visual-\ + cobol/vc50pu7/VS2019/HRLHLHINTR01U008.html *) + | "FREE", Cobol_config.DIALECT.MicroFocus -> Ok Cobol_config.SFXOpen + | "FREE", _ -> Ok SFFree + | "FIXED", _ -> Ok SFFixed + | "VARIABLE", _ -> Ok SFVariable + | "XOPEN", _ -> Ok SFXOpen + | "XCARD", _ -> Ok SFxCard + | "CRT", _ -> Ok SFCRT + | "TERMINAL", _ -> Ok SFTrm + | "COBOLX", _ -> Ok SFCOBOLX + | _ -> Error (`SFUnknown format) + +let select_source_format + : Cobol_config.source_format -> any_source_format = function + | SFFree -> SF ( NoIndic, FreePaging) + | SFFixed -> SF (FixedIndic, FixedWidth fixed_paging) + | SFVariable -> SF (FixedIndic, FixedWidth variable_paging) + | SFXOpen -> SF (XOpenIndic, FixedWidth xopen_paging) + | SFxCard -> SF (FixedIndic, FixedWidth xcard_paging) + | SFCRT -> SF ( CRTIndic, FixedWidth crt_paging) + | SFTrm -> SF ( TrmIndic, FixedWidth terminal_paging) + | SFCOBOLX -> SF ( CBLXIndic, FixedWidth cobolx_paging) + +(* --- *) + +let first_area_b_column + : type k. k source_format -> int option = function + | _, FreePaging + | XOpenIndic, _ -> None + | FixedIndic, FixedWidth _ -> Some (7 + 4) + |(CRTIndic | TrmIndic | + CBLXIndic), FixedWidth _ -> Some (1 + 4) + +(* --- *) + +type comment_entry_termination = (* skip until... *) + | Newline (* ... newline *) + | Period (* ... next period (unused) *) + | AreaB of { first_area_b_column: int } (* ... next word in area A *) + +let comment_entry_termination + : type k. k source_format -> comment_entry_termination = fun sf -> + match sf, first_area_b_column sf with + |(_ , FreePaging ), _ + |(XOpenIndic, _ ), _ + |(_ , _ ), None -> Newline + | (FixedIndic, FixedWidth _), Some c -> AreaB { first_area_b_column = c } + |((CRTIndic | + TrmIndic | + CBLXIndic), FixedWidth _), Some c -> AreaB { first_area_b_column = c } + +(* --- *) + +type 'k state = + { + lex_prods: text; + continued: continued; + pseudotext: (srcloc * text) option; + cdir_seen: bool; + newline: bool; + on_period_only: bool; (*newline on TextWord "." only if true, on any TextWord when false *) + diags: DIAGS.Set.t; + config: 'k config; + } +and continued = + | CNone + | CText of { + str: string with_loc; (** content *) + txt: prefix_kind; + } +and prefix_kind = + | CAlphanum of { + qte: quotation; (** quotation style *) + knd: literal_kind; (** possible typing prefix (N, X, B, etc.) *) + cld: bool; (** holds if properly closed with quotation *) + tbc: bool; (** to be continued flag (must) *) + unclosed_ebcdics: bool Lazy.t; + } +and 'k config = + { + debug: bool; + source_format: 'k source_format; + } + +(* TODO: get rid of `on_period_only` *) +let init_state on_period_only: 'k source_format -> 'k state = fun source_format -> + { + lex_prods = []; + continued = CNone; + pseudotext = None; + cdir_seen = false; + newline = true; + diags = DIAGS.Set.none; + on_period_only; + config = + { + debug = false; + source_format; + } + } + +let diagnostics { diags; _ } = diags + +let source_format { config = { source_format; _ }; _ } = + source_format + +let allow_debug { config = { debug; _ }; _ } = + debug + +(* Just check there are no buffered stuffs. *) +let flushed = function + | { lex_prods = []; continued = CNone; pseudotext = None; _ } -> true + | _ -> false + +let flush state = + { state with lex_prods = []; cdir_seen = false }, List.rev state.lex_prods + +let reset_cont state = + { state with continued = CNone } + +let lex_diag ~severity state = + DIAGS.Cont.kdiag severity + (fun d -> { state with diags = DIAGS.Set.cons d state.diags }) + +let lex_error state = lex_diag ~severity:DIAGS.Error state + +let change_source_format ({ config; _ } as state) { payload = sf; loc } = + if flushed state + then Ok { state with config = { config with source_format = sf } } + else Error (lex_error state ~loc "Forbidden@ change@ of@ source@ format") + +let pos_column Lexing.{ pos_bol; pos_cnum; _ } = (* count cols from 1 *) + pos_cnum - pos_bol + 1 + +let raw_loc ~start_pos ~end_pos { newline; config = { source_format; _ }; _ } = + let in_area_a = newline && match first_area_b_column source_format with + | None -> false + | Some c -> pos_column start_pos < c + in + Cobol_common.Srcloc.raw ~in_area_a (start_pos, end_pos) + +let emit prod ({ pseudotext; cdir_seen; _ } as state) = + match pseudotext with + | None -> + { state with lex_prods = prod :: state.lex_prods; + cdir_seen = cdir_seen || Text.cdirp prod; + newline = false } + | Some (start_loc, prods) -> + { state with pseudotext = Some (start_loc, prod :: prods); + cdir_seen = cdir_seen || Text.cdirp prod; + newline = false } + +let append t state = + match state, t with + | { pseudotext = None; + lex_prods = { payload = TextWord w; loc = wloc } :: tl; _ }, + { payload = TextWord s; loc = tloc } -> + let prod = TextWord (w ^ s) &@ (Cobol_common.Srcloc.concat wloc tloc) in + { state with lex_prods = prod :: tl; + newline = false } + | { pseudotext = Some (start_loc, { payload = TextWord w; + loc = wloc} :: prods); _ }, + { payload = TextWord s; loc = tloc } -> + let prod = TextWord (w ^ s) &@ (Cobol_common.Srcloc.concat wloc tloc) in + { state with pseudotext = Some (start_loc, prod :: prods); + newline = false } + | _, { loc; _ } -> + lex_error state ~loc "Unexpected@ `%a'@ in@ continuation" Text.pp_word t + +let new_line state lexbuf = + Lexing.new_line lexbuf; + match state.lex_prods, state.cdir_seen with + | { payload = (Pseudo _ | Eof); _ } :: _, _ | _, true -> + flush { state with newline = true } + | { payload = (TextWord "." ); _ } :: _, _ + when state.on_period_only -> + flush { state with newline = true } + | { payload = (TextWord _ | Alphanum _); _ } :: _, _ + when not @@ state.on_period_only -> + flush { state with newline = true } + | _ -> + { state with newline = true }, [] + +(* --- *) + +type _ c = Char: char c | Str: string c | Integer: int c + +let format_for (type k) : k c -> (k -> 'a, _, _, 'a) format4 = function + | Char -> "%c" + | Str -> "%s" + | Integer -> "%d" + +let unexpected (type k) (kind: k c) + ?(knd: Pretty.simple = "character") + ?(c: k option) + ?(severity = DIAGS.Error) + ~k state lexbuf = + let loc = + let end_pos = Lexing.lexeme_end_p lexbuf in + let start_pos = match kind with + | Str | Integer -> Lexing.lexeme_start_p lexbuf + | Char -> { end_pos with pos_cnum = end_pos.pos_cnum - 1 } (* last char *) + in + raw_loc ~start_pos ~end_pos state + in + let state = match c with + | None -> + lex_diag state "Unexpected@ %(%)" knd ~severity ~loc + | Some c -> + lex_diag state ("Unexpected@ %(%):@ `"^^format_for kind^^"'") knd c + ~severity ~loc + in + k state lexbuf + +(* --- *) + +(* Switch to upper-cased representation already: *) +let textword s = + TextWord (String.uppercase_ascii ~&s) &@<- s + +let cdirword: string with_loc -> text_word with_loc = fun { payload = s; loc } -> + let prefix = if String.(length s > 2 && sub s 0 2 <> ">>") then ">>" else "" in + CDirWord (String.uppercase_ascii @@ prefix ^ remove_blanks s) &@ loc + + +let rev_pseudotext: text -> _ state -> pseudotext * _ state = fun text state -> + List.fold_left begin fun (acc, state) pt -> match ~&pt with + | TextWord w -> + (Text.pseudo_string (w &@<- pt)) :: acc, state + | Alphanum a -> + (PseudoAlphanum a &@<- pt) :: acc, state + | _ -> + acc, lex_error state ~loc:~@pt "Unexpected@ `%a'@ in@ pseudotext" + Text.pp_word pt + end ([], state) text + +let pseudotext_delimiter ~loc = function + | { pseudotext = None; _ } as state -> + { state with pseudotext = Some (loc, []); + newline = false } + | { pseudotext = Some (start_loc, prods); _ } as state -> + assert (state.continued = CNone); + (* Here, we assume pseudotext only spans in a single text file. *) + let start_pos = Cobol_common.Srcloc.start_pos start_loc + and _, end_pos = Cobol_common.Srcloc.as_lexloc loc in + let loc = raw_loc ~start_pos ~end_pos state in + let state = { state with pseudotext = None; newline = false } in + let pseudotext, state = rev_pseudotext prods state in + emit (Pseudo pseudotext &@ loc) state + + +(* Hackish approach to deal with picture strings ending with a period or comma: + thankfully, they must be immediately followed by another period or comma and + terminate the sentence. As a result, text words may either terminate with + two periods, two commas, or no period or comma at all. + + We just intercept the emission of each text word s ending with either a dot + or a comma, and emit the dot separately or discard the comma. + + TODO: This currently applies in pseudo-text too; is this the expected + behavior? *) +let gen emit0 = function + | { payload = TextWord str; loc } as s -> + let len = String.length str in + (* XXX: may pos' end up with an invalid column number? *) + if len > 1 && str.[String.length str - 1] = '.' then + let sloc = Cobol_common.Srcloc.trunc_suffix 1 loc + and ploc = Cobol_common.Srcloc.suffix 1 loc in + fun state -> + emit0 (textword (String.sub str 0 (len - 1) &@ sloc)) state |> + emit (TextWord "." &@ ploc) + else if len > 1 && str.[String.length str - 1] = ',' then + let sloc = Cobol_common.Srcloc.trunc_suffix 1 loc in + emit0 @@ textword (String.sub str 0 (len - 1) &@ sloc) + else + emit0 s + | s -> + emit0 s + +let emit s = gen emit s +let append = gen append + +let flush_continued ?(force = false) state = match state.continued with + | CNone -> + state + | CText { txt = CAlphanum { tbc = true; _ }; _ } when not force -> + state + | CText { str = { payload = str; loc }; + txt = CAlphanum { qte; knd; cld = true; tbc = false; _ } } -> + emit (Alphanum { knd; qte; str } &@ loc) (reset_cont state) + | CText { str = { payload = str; loc }; + txt = CAlphanum { qte; knd; _ } } when force -> + lex_error (reset_cont state) ~loc "Missing@ continuation@ of@ `%s'" str |> + emit (Alphanum { knd; qte; str } &@ loc) + | CText { str = { payload = str; loc }; + txt = CAlphanum { qte; knd; _ } } -> + (* Missing continuation error is delayed until the final tokenization + stage to account for quotes in comment paragraphs. *) + emit (AlphanumPrefix { knd; qte; str } &@ loc) (reset_cont state) + +let eof state lexbuf = + let start_pos = Lexing.lexeme_start_p lexbuf + and end_pos = Lexing.lexeme_end_p lexbuf in + let loc = raw_loc ~start_pos ~end_pos state in + let state = flush_continued ~force:true state in (* checks state.continued *) + match state.pseudotext with (* and state.pseudotext *) + | None -> + emit (Eof &@ loc) state + | Some (start_loc, _prods) -> + let state = { state with pseudotext = None } in + (* As in `pseudotext_delimiter`, we assume pseudotext only spans in a + single text file. *) + let start_pos = Cobol_common.Srcloc.start_pos start_loc + and _, end_pos = Cobol_common.Srcloc.as_lexloc loc in + let loc = raw_loc ~start_pos ~end_pos state in + lex_error state ~loc "Unterminated@ pseudotext" |> + emit (Eof &@ loc) + +(* --- *) + +type line_fitting = Nominal | Tacked + +let text_word ?(cont = false) ?(fitting = Nominal) w state = + ignore fitting; + match state.continued with + | CNone when cont -> + append (textword w) state + | CNone -> + emit (textword w) state + | CText _ -> + let state = flush_continued ~force:true state in + let state = lex_error state ~loc:~@w "Unexpected@ text@ word" in + emit (textword w) state + + +let to_be_continued_alphanum: string -> bool = + fun s -> match s.[0], Str.last_chars s 2 with + | '"', "\"-" + | '\'', "'-" -> true + | _ -> false + | exception Invalid_argument _ -> false + +let closed_alphanum: string -> bool = + (* Note we allow alphanumeric tokens to be empty, although some old standards + may forbid them; this may be checked later on though. *) + let count_char c s = + String.to_seq s |> Seq.fold_left (fun i c' -> if c == c' then succ i else i) 0 + in + fun s -> + String.length s >= 2 && + match s.[0], (Str.last_chars s 1, Str.last_chars s 2) with + | '\'', ("'", _ | _, "'-") -> count_char '\'' s mod 2 == 0 + | '"', ("\"", _ | _, "\"-") -> count_char '"' s mod 2 == 0 + | _ -> false (* in case *) + | exception Invalid_argument _ -> true (* in case *) + +let strip_left_quote str = + String.sub str 1 (String.length str - 1) + +let strip_right_quote str = + String.sub str 0 (String.length str - 1) + +let strip_quotes str = + let len = String.length str in + if to_be_continued_alphanum str then String.sub str 1 (len - 3) + else if closed_alphanum str then String.sub str 1 (len - 2) + else String.sub str 1 (len - 1) + +let unclosed_ebcdics = + (* NOTE: applies on internal representation, i.e, without surrounding + quotes/apostrophes. *) + let symc = "[0-9][0-9, ]*" in (* symbolic EBCDIC *) + let dblq = "\\([^\"]\\|\"" ^ symc ^ "\"\\|\"\"\\)*\"" ^ symc in + let splq = "\\([^']\\|'" ^ symc ^ "\"\\|''\\)*'" ^ symc in + let re = Str.regexp ("^\\(" ^ dblq ^ "\\|" ^ splq ^ "\\)$") in + fun str -> Str.string_match re str 0 + +let quoted_alphanum ?(fitting = Nominal) ~knd + ({ payload = str; _ } as str') state = + (* Note substitution of doubled quotation or apostrophe marks is delayed until + after text manipulation stage. *) + let cld = closed_alphanum str + and tbc = to_be_continued_alphanum str + and qte = if str.[0] = '\'' then Apostrophe else Quote in + match state.continued with + | CNone when fitting = Nominal && cld && not tbc -> + emit (Alphanum { knd; qte; str = strip_quotes str } &@<- str') state + | CNone -> + let str = strip_quotes str in + let unclosed_ebcdics = lazy (unclosed_ebcdics str) in + { state with + continued = CText { str = str &@<- str'; + txt = CAlphanum { qte; knd; cld; tbc; + unclosed_ebcdics }; }; + newline = false } + | CText { str = s0; + txt = CAlphanum { qte = q0; knd = k0; _ }; _ } -> + let state = + if q0 <> qte + then lex_error state ~loc:~@str' "Mismatch@ in@ continuation@ of@ \ + alphanumeric@ literal@ (expected@ \ + `%a'@ quotation@ character)\ + " Text.pp_quote q0 + else state + in + let str = ~&s0 ^ strip_left_quote str + and strloc = Cobol_common.Srcloc.concat ~@s0 ~@str' in + let cld = match qte with + | Quote -> closed_alphanum ("\"" ^ str) + | Apostrophe -> closed_alphanum ("'" ^ str) + in + let str = if cld then strip_right_quote str else str in + if fitting = Nominal && cld && not tbc then + emit (Alphanum { knd = k0; qte; str } &@ strloc) (reset_cont state) + else + let unclosed_ebcdics = lazy (unclosed_ebcdics str) in + { state with + continued = CText { str = str &@ strloc; + txt = CAlphanum { qte; knd = k0; cld; tbc; + unclosed_ebcdics } }; + newline = false } + +type alphanumeric_continuation = + | Nominal + | Closed of Text.quotation + | UnclosedEBCDICs of Text.quotation + +let continue_quoted_alphanum state = match state.continued with + | CText { txt = CAlphanum { qte; cld; tbc; _ }; _ } + when cld && not tbc -> + Closed qte + | CText { txt = CAlphanum { qte; cld; tbc; unclosed_ebcdics; _ }; _ } + when not cld && not tbc && Lazy.force unclosed_ebcdics -> + UnclosedEBCDICs qte + | _ -> + Nominal + +(* --- *) + +let extract_knd str state lexbuf = + let open struct + exception UnexpectedChar of char + exception UnexpectedStr + end in + let unexpected = + unexpected ~knd:"opening delimiter for alphanumeric literal" in + try + (* TODO: use start_pos & end_pos instead (see below) *) + let s, knd = match str.[0] with + | '"' | '\'' -> str, Basic + | 'B' -> Str.string_after str 1, Bool + | 'X' -> Str.string_after str 1, Hex + | 'Z' -> Str.string_after str 1, NullTerm + | 'N' -> Str.string_after str 1, National + | c -> raise @@ UnexpectedChar c + in + let s, knd = match s.[0], knd with + |('"' | '\''), knd -> s, knd + | 'X', Bool -> Str.string_after s 1, BoolX + | 'X', National -> Str.string_after s 1, NationalX + | _ -> raise @@ UnexpectedStr + in + s, knd, state + with + | UnexpectedChar c -> + unexpected Char ~c state lexbuf + ~k:(fun state _lexbuf -> Str.string_after str 1, Basic, state) + | UnexpectedStr -> + unexpected Str state lexbuf + ~k:(fun state _lexbuf -> Str.string_after str 2, Basic, state) + + +type lexeme_info = string * Lexing.position * Lexing.position +let lexeme_info lexbuf : lexeme_info = + Lexing.(lexeme lexbuf, lexeme_start_p lexbuf, lexeme_end_p lexbuf) + +let trunc_to_col n ((s, sp, ep) as info: lexeme_info) = + let sc = pos_column sp and ec = pos_column ep in + assert (sc <= n); (* starts on last column (CHECKME: always avoided?) *) + if ec <= n + then + info, if ec = n + 1 then Tacked else Nominal + else (* truncate lexeme and shift end position accordingly *) + let s = String.sub s 0 (n - sc + 1) in + (s, sp, { ep with pos_cnum = ep.pos_cnum - ec + n + 1}), Tacked + +let fixed_text mk ({ config = { source_format; _ }; _ } as state) lexbuf = + let _, FixedWidth { cut_at_col; _ } = source_format in + let (_, start_pos, _) as lexinf = lexeme_info lexbuf in + if pos_column start_pos > cut_at_col then + state, Tacked + else + let (s, start_pos, end_pos), fitting = trunc_to_col cut_at_col lexinf in + let sloc = raw_loc ~start_pos ~end_pos state in + mk ?fitting:(Some fitting) (s &@ sloc) state, fitting + +let fixed_text_word ?cont = fixed_text (text_word ?cont) +let fixed_nocont mk = fixed_text (fun ?fitting s -> ignore fitting; emit (mk s)) +let fixed_cdir_word = fixed_nocont cdirword (* cannot be broken across lines *) +let fixed_eqeq = fixed_text begin fun ?fitting -> function + | { payload = "=="; loc } -> + pseudotext_delimiter ~loc + | { payload = str; _ } as s -> + assert (str = "="); (* necessarily "=" *) + text_word ?fitting s + end + +let continuing_unclosed_ebcdics = function + | { continued = CText { txt = CAlphanum { unclosed_ebcdics; _ }; _ }; _ } -> + Lazy.force unclosed_ebcdics + | _ -> false + +let fixed_alphanum_lit + ?(doubled_opener = false) + ({ config = { source_format; _ }; _ } as state) + lexbuf + = + let _, FixedWidth { cut_at_col; alphanum_padding } = source_format in + let (_, start_pos, end_pos) as lexinf = lexeme_info lexbuf in + let end_col = pos_column end_pos in + assert (pos_column end_pos > 0); (* should never have zero-length token *) + if pos_column start_pos > cut_at_col then + state, Tacked + else + let (s, start_pos, end_pos), fitting = trunc_to_col cut_at_col lexinf in + let s, knd, state = extract_knd s state lexbuf in + let s, end_pos, fitting = + (* Actually double the opening delimiter ('\'' or '"'), to have the + doubled quote/apostrophe character prefix after stripping of opening + and closing delimiters in `quoted_alphanum`. *) + let s = if doubled_opener then String.sub s 0 1 ^ s else s in + let length_to_right_col = cut_at_col - end_col + 1 in + if closed_alphanum s || length_to_right_col <= 0 || + continuing_unclosed_ebcdics state + then s, end_pos, fitting + else match alphanum_padding with + | None -> + s, end_pos, Tacked + | Some c -> + let pos_cnum = end_pos.pos_cnum + length_to_right_col in + let end_pos = { end_pos with pos_cnum } in + s ^ String.make length_to_right_col c, end_pos, Tacked + in + let loc = raw_loc ~start_pos ~end_pos state in + quoted_alphanum ~fitting ~knd (s &@ loc) state, fitting + +(* --- *) + +let fixed_text mk ~ktkd ~knom state lexbuf = + let state, fitting = mk state lexbuf in + (if fitting = Tacked then ktkd else knom) state lexbuf + +let text_word ?cont = fixed_text (fixed_text_word ?cont) +let cdir_word s = fixed_text fixed_cdir_word s +let eqeq s = fixed_text fixed_eqeq s +let alphanum_lit ?doubled_opener = + fixed_text (fixed_alphanum_lit ?doubled_opener) + +(* Free-format versions: *) + +let free_srctok mk state lexbuf = + let s = Lexing.lexeme lexbuf in + let start_pos = Lexing.lexeme_start_p lexbuf + and end_pos = Lexing.lexeme_end_p lexbuf in + mk (s &@ raw_loc ~start_pos ~end_pos state) state + +let emit_srctok mk = free_srctok (fun s -> emit (mk s)) + +let free_text_word s = emit_srctok textword s +let free_cdir_word s = emit_srctok cdirword s +let free_eqeq s = free_srctok (fun { loc; _ } -> pseudotext_delimiter ~loc) s +let free_alphanum_lit state lexbuf = + let s = Lexing.lexeme lexbuf + and start_pos = Lexing.lexeme_start_p lexbuf + and end_pos = Lexing.lexeme_end_p lexbuf in + (* TODO: pass (start_pos, end_pos) to extract_knd *) + let s, knd, state = extract_knd s state lexbuf in + quoted_alphanum ~knd (s &@ raw_loc ~start_pos ~end_pos state) state + +(* --- *) + +let free_text mk ~k state lexbuf = k (mk state lexbuf) lexbuf + +let text_word' ~k = free_text free_text_word ~k +let cdir_word' ~k = free_text free_cdir_word ~k +let eqeq' ~k = free_text free_eqeq ~k +let alphanum_lit' ~k = free_text free_alphanum_lit ~k + +(* --- *) diff --git a/src/lsp/cobol_preproc/src_lexing.mli b/src/lsp/cobol_preproc/src_lexing.mli new file mode 100644 index 000000000..4b42651d0 --- /dev/null +++ b/src/lsp/cobol_preproc/src_lexing.mli @@ -0,0 +1,121 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* Paging *) + +type free = | +type fixed = | +type _ paging = + | FreePaging: free paging + | FixedWidth: fixed_paging_params -> fixed paging +and fixed_paging_params = + { + cut_at_col: int; + alphanum_padding: char option; + } + +(* Actual format and indicator positioning *) + +type 'k source_format = 'k indicator_position * 'k paging +and _ indicator_position = + | NoIndic: free indicator_position + | FixedIndic: fixed indicator_position + | XOpenIndic: fixed indicator_position + | CRTIndic: fixed indicator_position + | TrmIndic: fixed indicator_position + | CBLXIndic: fixed indicator_position +and any_source_format = + | SF: 'k source_format -> any_source_format [@@unboxed] + +type comment_entry_termination = (* skip until... *) + | Newline (* ... newline *) + | Period (* ... next period (unused) *) + | AreaB of { first_area_b_column: int } (* ... next word in area A *) + +val select_source_format: Cobol_config.source_format -> any_source_format +val source_format_spec: 'k source_format -> Cobol_config.source_format +val same_source_formats: 'k source_format -> 'r source_format -> bool +val comment_entry_termination: 'k source_format -> comment_entry_termination +val decypher_source_format + : dialect:Cobol_config.dialect + -> string + -> (Cobol_config.source_format, [> `SFUnknown of string ]) result + +type 'k state +val init_state: bool -> 'k source_format -> 'k state +val diagnostics: _ state -> Cobol_common.Diagnostics.Set.t +val source_format: 'k state -> 'k source_format +val change_source_format: 'k state -> 'c source_format Cobol_common.Srcloc.with_loc + -> ('c state, 'k state) result +val allow_debug: 'a state -> bool +val flush: 'a state -> 'a state * Text.text +val flush_continued: ?force:bool -> 'a state -> 'a state +val eof: 'a state -> Lexing.lexbuf -> 'a state +val new_line: 'a state -> Lexing.lexbuf -> 'a state * Text.text + +type alphanumeric_continuation = + | Nominal + | Closed of Text.quotation + | UnclosedEBCDICs of Text.quotation +val continue_quoted_alphanum + : 'a state + -> alphanumeric_continuation + +val eqeq : + fixed state -> + ktkd:(fixed state -> Lexing.lexbuf -> 'a) -> + knom:(fixed state -> Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'a +val eqeq' : + k:('a state -> Lexing.lexbuf -> 'b) -> + 'a state -> Lexing.lexbuf -> 'b + +val cdir_word : + fixed state -> + ktkd:(fixed state -> Lexing.lexbuf -> 'a) -> + knom:(fixed state -> Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'a +val cdir_word' : + k:('a state -> Lexing.lexbuf -> 'b) -> + 'a state -> Lexing.lexbuf -> 'b +val text_word : + ?cont:bool -> + ktkd:(fixed state -> Lexing.lexbuf -> 'a) -> + knom:(fixed state -> Lexing.lexbuf -> 'a) -> + fixed state -> Lexing.lexbuf -> 'a +val text_word' : + k:('a state -> Lexing.lexbuf -> 'b) -> + 'a state -> Lexing.lexbuf -> 'b +val alphanum_lit : + ?doubled_opener:bool -> + ktkd:(fixed state -> Lexing.lexbuf -> 'a) -> + knom:(fixed state -> Lexing.lexbuf -> 'a) -> + fixed state -> Lexing.lexbuf -> 'a +val alphanum_lit' : + k:('a state -> Lexing.lexbuf -> 'b) -> + 'a state -> Lexing.lexbuf -> 'b + +(* --- *) + +val lex_diag + : severity:Cobol_common.Diagnostics.severity + -> 'a state + -> ?loc:Cobol_common.Srcloc.srcloc + -> (_, 'a state) Pretty.func + +type _ c = Char: char c | Str: string c | Integer: int c +val unexpected + : 'a c + -> ?knd:Pretty.simple + -> ?c:'a + -> ?severity:Cobol_common.Diagnostics.severity + -> k:('k state -> Lexing.lexbuf -> 'b) + -> 'k state -> Lexing.lexbuf -> 'b diff --git a/src/lsp/cobol_preproc/src_overlay.ml b/src/lsp/cobol_preproc/src_overlay.ml new file mode 100644 index 000000000..e073ff002 --- /dev/null +++ b/src/lsp/cobol_preproc/src_overlay.ml @@ -0,0 +1,157 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module TYPES = struct + type limit = Lexing.position +end +include TYPES + +type srcloc = Cobol_common.Srcloc.srcloc (* alias for shortening definitions *) + +module type MANAGER = sig + type limit := limit + val id: string + val limits: srcloc -> limit * limit + val link_limits: limit -> limit -> unit + val join_limits: limit * limit -> srcloc + val dummy_limit: limit +end + +(** Overlay limits (internal) *) +module Limit = struct + + type t = limit + + let make_virtual: unit -> t = + let id = ref 0 in + fun () -> + decr id; + Lexing.{ dummy_pos with pos_lnum = !id } + + let is_virtual: t -> bool = + fun l -> l.Lexing.pos_lnum < 0 + + (* Structural equality is required below, to deal with cases where we + construct the limits of a token several times, for instance at the + beginning of recovery. *) + let equal = (=) + let hash = Hashtbl.hash +end + +(** Weak hashtable where keys are overlay limits (internal) *) +module Links = Ephemeron.K1.Make (Limit) + +(** Managers for sequences of overlay token limits *) +type manager = + { + right_of: (srcloc * limit) Links.t; (** associates the left limit of a token + to its location and the + corresponding right limit. *) + over_right_gap: limit Links.t; (** associates the right limit of a token to + the left limit of the next *) + id: string; (** manager identifier (for logging/debugging) *) + } + +(** Manager initialization *) +let new_manager: string -> manager = + let id = ref 0 in + fun manager_name -> + incr id; + { + right_of = Links.create 42; + over_right_gap = Links.create 42; + id = Pretty.to_string "%s-%u" manager_name !id; + } + +(** Returns left and right (potentially fresh) limits for the given source + location *) +let limits: manager -> srcloc -> limit * limit = fun ctx loc -> + let s, e = match Cobol_common.Srcloc.as_unique_lexloc loc with + | Some lexloc -> lexloc + | _ -> Limit.make_virtual (), Limit.make_virtual () + in + Links.replace ctx.right_of s (loc, e); (* replace to deal with duplicates *) + s, e + +(** Links token limits *) +let link_limits ctx left right = + (* Replace to deal with overriding of limits during recovery. *) + Links.replace ctx.over_right_gap left right + +(** [leftmost_limit_in ~filename ctx] finds the leftmost limit from a location + in [filename] that is registered in [ctx] (internal). Use with moderation + as this is quite inefficient. *) +let leftmost_limit_in ~filename ctx = + Links.fold begin fun l _ -> function + | None when l.Lexing.pos_fname = filename -> Some l + | Some l' when l.Lexing.pos_cnum < l'.pos_cnum && + l.Lexing.pos_fname = filename -> Some l + | res -> res + end ctx.right_of None + +(** Returns a source location that spans between two given limits; returns a + valid pointwise location if the two given limits are physically equal. *) +let join_limits: manager -> limit * limit -> srcloc = fun ctx (s, e) -> + let pointwise l = (* pointwise: ensure this is not a virtual limit *) + let pos = + if Limit.is_virtual l then + let s = Links.find ctx.over_right_gap l in + let loc, _ = Links.find ctx.right_of s in + Cobol_common.Srcloc.start_pos loc + else l + in + Cobol_common.Srcloc.raw (pos, pos) + in + let try_limits (s, e) = + let rec jump_right loc e' = + let s' = Links.find ctx.over_right_gap e' in + let loc', e' = Links.find ctx.right_of s' in + check (Cobol_common.Srcloc.concat loc loc') e' + and check loc e' = + if e == e' (* physical comparison *) + then loc + else jump_right loc e' + in + if s == e + then pointwise s + else let loc, e' = Links.find ctx.right_of s in check loc e' + in + let join_failure (s, e) = + let loc = Cobol_common.Srcloc.raw (s, e) in + Pretty.error "@[<2>%a:@ Internal@ warning:@ unable@ to@ join@ locations@ \ + via@ limits@ in@ `%s.join_limits`@ [ctx=%s]@]@." + Cobol_common.Srcloc.pp_file_loc loc __MODULE__ ctx.id; + (* Printexc.(print_raw_backtrace Stdlib.stderr @@ get_callstack 10); *) + loc + in + (* first attempt assumes proper token limits: `s` is a left and `e` is a right + of tokens *) + try try_limits (s, e) with Not_found -> + (* try assuming `s` is an end of token *) + try try_limits (Links.find ctx.over_right_gap s, e) with Not_found -> + if s.pos_cnum = 0 (* potential special case with left-position forged by the + parser: retry with leftmost limit if it differs from + s *) + then match leftmost_limit_in ~filename:s.pos_fname ctx with + | Some l when l != s -> try_limits (l, e) (* physical equality is enough *) + | Some _ | None -> join_failure (s, e) + else join_failure (s, e) + +module New_manager (Id: sig val name: string end) : MANAGER = struct + let ctx = new_manager Id.name + let id = ctx.id + let limits = limits ctx + let link_limits = link_limits ctx + let join_limits = join_limits ctx + let dummy_limit = Lexing.dummy_pos +end diff --git a/src/lsp/cobol_preproc/src_overlay.mli b/src/lsp/cobol_preproc/src_overlay.mli new file mode 100644 index 000000000..45bef81a9 --- /dev/null +++ b/src/lsp/cobol_preproc/src_overlay.mli @@ -0,0 +1,54 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** A source overlay associates complex source code elements with virtual limits + of lexing tokens that can be fed to parsers so as to tag ASTs with complex + source locations. *) + +(* For now, it does not seem worth making this generic in + `Cobol_common.Srcloc.srcloc` via an additional functor. *) + +(** Source overlay limits, that MUST be considered abstract and whose contents + must not be inspected nor relied upon outside of this module. Such limits + are to be fed to parsers, that usually expect lexing positons, so + unfortunately we can neither make this type abstract nor private. *) +type limit = (* private *) Lexing.position + +(** Manager of source overlay limits. Includes some mutable state. *) +module type MANAGER = sig + + (** Identifier of the manager; may be used for debugging. *) + val id: string + + (** [limits loc] creates and returns the left- and right-limit to the given + location. *) + val limits: Cobol_common.Srcloc.srcloc -> limit * limit + + (** [link_limits left right] links the right limit of a token [t] to the left + limit of the subsequent token [t'] (that is to be fed to the parser right + after [t]). *) + val link_limits: limit -> limit -> unit + + (** [join_limits (start_limit, end_limit)] returns a source location that + spans from [start_limit] to [end_limit]. [start_limit] must have been + built (via {!limits}) {i before} [end_limit]. *) + val join_limits: limit * limit -> Cobol_common.Srcloc.srcloc + + (** [dummy_limit] is a limit that may be fed to a parser or {!join_limits}, + but not given to {!link_limits} below. *) + val dummy_limit: limit + +end + +(** Nanager module instantiation *) +module New_manager: functor (Id: sig val name: string end) -> MANAGER diff --git a/src/lsp/cobol_preproc/text.ml b/src/lsp/cobol_preproc/text.ml new file mode 100644 index 000000000..cb1ca1944 --- /dev/null +++ b/src/lsp/cobol_preproc/text.ml @@ -0,0 +1,134 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_common.Srcloc.INFIX + +(* --- *) + +module TYPES = Text_types +include TYPES + +let prefix_of_literal_kind: literal_kind -> string = function + | Basic -> "" + | Bool -> "B" + | BoolX -> "BX" + | Hex -> "X" + | NullTerm -> "Z" + | National -> "N" + | NationalX -> "NX" + +let char_of_quotation: quotation -> char = function + | Apostrophe -> '\'' + | Quote -> '"' + +module FMT = struct + + let pp_literal_kind ppf kind = + Pretty.string ppf (prefix_of_literal_kind kind) + + let pp_quote ppf quote = + Pretty.char ppf (char_of_quotation quote) + + let pp_alphanum ppf { knd; qte; str } = + Pretty.print ppf "%a%a%s%a" + pp_literal_kind knd pp_quote qte str pp_quote qte + + let pp_pseudoword ppf w = match ~&w with + | PseudoWord strs -> + Pretty.list ~fopen:"" ~fclose:"" ~fsep:"" ~fempty:"" + begin fun ppf { payload = PwText s | PwDelim (s, _); _ } -> + Pretty.string ppf s + end ppf strs + | PseudoAlphanum a -> + pp_alphanum ppf a + + let pp_pseudotext = + Pretty.list ~fopen:"==" ~fsep:" "~fclose:"==" pp_pseudoword + + let pp_word ppf word = match ~&word with + | TextWord str + | CDirWord str -> + Pretty.string ppf str + | Alphanum a -> + pp_alphanum ppf a + | AlphanumPrefix { knd; qte; str } -> + Pretty.print ppf "%a%a%s" pp_literal_kind knd pp_quote qte str + | Pseudo pl -> + pp_pseudotext ppf pl + | Eof -> + Pretty.string ppf "EOF" + + let pp_text fmt = + Pretty.list ~fopen:"@[" ~fsep:"@;" ~fclose:"@]" pp_word fmt + +end +include FMT + +(* Various predicates on source-flagged character strings *) + +let textwordp t = match ~&t with TextWord _ -> true | _ -> false +let textword_eqp ~eq:w t = match ~&t with TextWord t -> t = w | _ -> false +let cdirp t = match ~&t with CDirWord _ -> true | _ -> false +let cdir_eqp ~eq:w t = match ~&t with CDirWord t -> t = w | _ -> false + +(* Manipulating pseudo-words and text *) + +let pseudosep_regexp = + Str.regexp "[:()]" + +let split_pseudo_string w = + let split_loc loc str = + let len = String.length str in + Cobol_common.Srcloc.prefix len loc, + Cobol_common.Srcloc.trunc_prefix len loc + in + let pseudoword_items, _ = + Str.full_split pseudosep_regexp ~&w |> + List.fold_left begin fun (acc, wloc) w -> match w with + | Str.Text t -> + let tloc, wloc = split_loc wloc t in + (PwText t &@ tloc) :: acc, wloc + | Str.Delim d -> + let dloc, wloc = split_loc wloc d in + (PwDelim (d, Str.regexp (Str.quote d)) &@ dloc) :: acc, wloc + end ([], ~@w) + in + List.rev pseudoword_items + +let join_pseudo_string ~string = + List.fold_left begin fun pw { payload = PwText w | PwDelim (w, _); loc } -> + match pw with + | None -> Some (string (w &@ loc)) + | Some pw -> Some (Cobol_common.Srcloc.concat_strings_with_loc pw (w &@ loc)) + end None + +let pseudo_string w = + PseudoWord (split_pseudo_string w) &@<- w +let pseudo_alphanum a = + PseudoAlphanum { str = fst ~&a; qte = snd ~&a; knd = Basic } &@<- a +let pseudo_integer i = + PseudoWord [PwText (Int64.to_string ~&i) &@<- i] &@<- i +let alphanum_as_pseudo a = + PseudoWord [PwText (fst ~&a) &@<- a] &@<- a + +let pseudoword_of_string: _ -> pseudoword = pseudo_string +let pseudoword_of_alphanum: _ -> pseudoword = pseudo_alphanum +let pseudoword_of_integer: _ -> pseudoword = pseudo_integer +let alphanum_as_pseudoword a = alphanum_as_pseudo a + +let pseudotext_ f x = [f x] &@ ~@x +let pseudotext_of_string = pseudotext_ pseudo_string +let pseudotext_of_alphanum = pseudotext_ pseudo_alphanum +let pseudotext_of_integer = pseudotext_ pseudo_integer +let alphanum_as_pseudotext a = pseudotext_ alphanum_as_pseudo a diff --git a/src/lsp/cobol_preproc/text.mli b/src/lsp/cobol_preproc/text.mli new file mode 100644 index 000000000..7358f7fcb --- /dev/null +++ b/src/lsp/cobol_preproc/text.mli @@ -0,0 +1,55 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc + +module TYPES = Text_types +include module type of Text_types + +val textwordp : text_word with_loc -> bool +val textword_eqp : eq:string -> text_word with_loc -> bool + +val cdirp : text_word with_loc -> bool +val cdir_eqp : eq:string -> text_word with_loc -> bool + +val join_pseudo_string + : string:((string with_loc as 'a) -> 'a) + -> pseudoword_item with_loc list + -> 'a option + +val pseudo_string: string with_loc -> pseudoword +val pseudoword_of_string : string with_loc -> pseudoword +val pseudoword_of_alphanum : (string * quotation) with_loc -> pseudoword +val pseudoword_of_integer : int64 with_loc -> pseudoword + +val alphanum_as_pseudoword : (string * 'a) with_loc -> pseudoword + +val pseudotext_of_string : + string with_loc -> pseudotext with_loc +val pseudotext_of_alphanum : + (string * quotation) with_loc -> pseudotext with_loc +val pseudotext_of_integer : + int64 with_loc -> pseudotext with_loc +val alphanum_as_pseudotext : + (string * 'a) with_loc -> pseudotext with_loc + + +val pp_text: text Pretty.printer +val pp_quote: quotation Pretty.printer +val pp_word: text_word with_loc Pretty.printer +val pp_pseudotext: pseudotext Pretty.printer +val pp_literal_kind: literal_kind Pretty.printer +val pp_alphanum: alphanum Pretty.printer + +val prefix_of_literal_kind: literal_kind -> string +val char_of_quotation: quotation -> char diff --git a/src/lsp/cobol_preproc/text_printer.ml b/src/lsp/cobol_preproc/text_printer.ml new file mode 100644 index 000000000..10b03f213 --- /dev/null +++ b/src/lsp/cobol_preproc/text_printer.ml @@ -0,0 +1,172 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Text + +(* cobc support does not currently work because, when replacing is + done, the location of the new token is the location of the + replacing token. Since that location is used to display #area_a + directives, such directives may wrongly be added or removed. + + TODO:To fix this, the location of the first replaced token should + be kept for the first replacing token. *) + + +type pos = { + file : string ; + line : int ; + char : int ; + + (* cobc specific stuff *) + divisions_seen : int ; (* ignore comments if == 1 *) + ignore_paragraph : bool ; (* are we ignoring current paragraph ? *) +} + +(* if cobc && divisions_seen == 1, these paragraphs should be ignored *) +let cobc_ignore_paragraph_after = function + | "AUTHOR" + | "DATE-WRITTEN" + | "DATE-MODIFIED" + | "DATE-COMPILED" + | "INSTALLATION" + | "REMARKS" + | "SECURITY"-> true + | _ -> false + +(* TODO: if two following tokens are of type TextWord, we might + attempt to merge them, disregarding the location of the second + token. Maybe it is not necessary, practice will tell. *) +let string_of_text ?(cobc=false) ?(max_line_gap=1) text = + + let b = Buffer.create 65_000 in + let rec move_to_loc pos loc = + let start_pos = + (* CHECKME: Give the actual position of the first token leading to a + source location; behavior when in copied/replaced pseudotext needs to + be checked. *) + Cobol_common.Srcloc.start_pos loc + in + let Lexing.{ pos_lnum ; pos_fname; pos_bol ; pos_cnum ; _ } = start_pos in + let pos_lnum = pos_lnum - 1 in + let pos_cnum = pos_cnum - pos_bol in + (* Printf.eprintf "pos_lnum = %d, pos_cnum = %d\n%!" pos_lnum pos_cnum; *) + if pos_fname <> pos.file then begin + if pos.char <> 0 then Buffer.add_char b '\n'; + Printf.bprintf b "#line %d \"%s\"\n" (pos_lnum+1) pos_fname; + let pos = { pos with file = pos_fname ; line = pos_lnum ; char = 0 } in + move_to_loc pos loc + end else + if pos_lnum < pos.line + || ( pos_lnum = pos.line && pos_cnum < pos.char ) + || pos_lnum > pos.line + max_line_gap + then begin + if pos.char <> 0 then Buffer.add_char b '\n'; + Printf.bprintf b "#line %d \"%s\"\n" (pos_lnum+1) pos_fname; + let pos = { pos with file = pos_fname ; line = pos_lnum ; char = 0 } in + move_to_loc pos loc + end else + if pos_lnum > pos.line then begin + Buffer.add_char b '\n'; + let pos = { pos with file = pos_fname ; line = pos.line+1 ; char = 0 } in + move_to_loc pos loc + end else + if cobc && pos.char == 0 && + (pos_cnum >= 7 && pos_cnum < 11) then begin + Buffer.add_string b "\n#area_a\n"; + let pos = { pos with char = pos.char + 6; ignore_paragraph = false } in + move_to_loc pos loc + end else + if pos_cnum > pos.char then begin + Buffer.add_char b ' '; + let pos = { pos with char = pos.char + 1 } in + move_to_loc pos loc + end else + pos (* TODO *) + in + let advance_of pos s = + { pos with char = pos.char + String.length s } (* Handle newlines *) + in + let string_of_word chstr = + match chstr with + | TextWord str -> + str + | CDirWord str -> + str + | Alphanum { knd; qte; str } -> + let c = Text.char_of_quotation qte in + let prefix = Text.prefix_of_literal_kind knd in + Printf.sprintf "%s%c%s%c" + prefix c str c + | AlphanumPrefix { knd; qte; str } -> + let c = Text.char_of_quotation qte in + let prefix = Text.prefix_of_literal_kind knd in + Printf.sprintf "%s%c%s" + prefix c str + | Pseudo pl -> + Printf.sprintf "==%s==" + ( String.concat " " @@ + List.map (fun { payload = pseudo; _ } -> + match pseudo with + | PseudoWord strs -> + String.concat "" @@ + List.map begin function + | { payload = PwText s | PwDelim (s, _); _ } -> s + end strs + | PseudoAlphanum { knd; qte; str } -> + let c = Text.char_of_quotation qte in + let prefix = Text.prefix_of_literal_kind knd in + Printf.sprintf "%s%c%s%c" + prefix c str c + ) pl) + | Eof -> "" + in + let rec iter pos text = + match text with + | [] -> Buffer.add_char b '\n'; Buffer.contents b + | chstr_loc :: text -> + let chstr = Cobol_common.Srcloc.payload chstr_loc in + let loc = Cobol_common.Srcloc.loc chstr_loc in + let pos = move_to_loc pos loc in + let s = string_of_word chstr in + let pos = + if s = "DIVISION" then + { pos with divisions_seen = pos.divisions_seen + 1 } + else + if cobc && pos.divisions_seen = 1 && + cobc_ignore_paragraph_after s then + { pos with ignore_paragraph = true; } + else + pos + in + let s = if pos.ignore_paragraph then "" else s in + Buffer.add_string b s; + + (* ONLY FOR DEBUG: display locations on stderr + begin + let Lexing.{ pos_lnum ; pos_fname; pos_bol ; pos_cnum ; _ } = + fst ( List.hd loc ) in + let pos_lnum = pos_lnum - 1 in + let pos_cnum = pos_cnum - pos_bol in + Printf.eprintf "{ pos_fname = %s, pos_lnum = %d, pos_cnum = %d} -> [%s]\n%!" + pos_fname pos_lnum pos_cnum s + end; + *) + + let pos = advance_of pos s in + iter pos text + in + iter { + file = "" ; line = 0 ; char = 0; + divisions_seen = 0; ignore_paragraph = false; + } text diff --git a/src/lsp/cobol_preproc/text_printer.mli b/src/lsp/cobol_preproc/text_printer.mli new file mode 100644 index 000000000..41fb6a1c0 --- /dev/null +++ b/src/lsp/cobol_preproc/text_printer.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* Generate a string with locations pragmas, so that the file can be + read again *) +val string_of_text : + ?cobc:bool -> ?max_line_gap:int -> Text.text -> string diff --git a/src/lsp/cobol_preproc/text_supplier.ml b/src/lsp/cobol_preproc/text_supplier.ml new file mode 100644 index 000000000..e9da1c8f6 --- /dev/null +++ b/src/lsp/cobol_preproc/text_supplier.ml @@ -0,0 +1,84 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.INFIX +open Text.TYPES + +(** [pptoks_of_chstr w] translates a COBOL character string [w] into + pre-processor tokens. Note numeric literals keep their representation as + text-words ({!TEXT_WORD}) in the result. *) +let pptoks_of_chstr (chstr: text_word Cobol_common.Srcloc.with_loc) = + let open Preproc_tokens in + match ~&chstr with + | CDirWord w + | TextWord w + -> List.rev @@ Cobol_common.Tokenizing.fold_tokens (w &@<- chstr) [] + ~tokenizer:(fun ~loc:_ -> Src_lexer.pptoken) + ~until:(function PPEnd -> true | _ -> false) + ~f:begin fun t -> match ~&t with + | PPEnd -> Fun.id + | PPTok tok -> List.cons (tok &@<- t) + end + | Alphanum { knd = Basic; str; qte; _ } + -> [ALPHANUM (str, qte) &@<- chstr] + | Alphanum { knd = National | NationalX; str; _ } + -> [NATLIT str &@<- chstr] + | Alphanum { knd = Bool | BoolX; str; _ } + -> [BOOLIT str &@<- chstr] + | Alphanum { knd = Hex; str; _ } + -> [HEXLIT str &@<- chstr] + | Alphanum { knd = NullTerm; str; _ } + -> [NULLIT str &@<- chstr] + | AlphanumPrefix { str; qte; _ } + -> [ALPHANUM_PREFIX (str, qte) &@<- chstr] + | Pseudo p + -> [PSEUDO_TEXT p &@<- chstr] + | Eof + -> [EOL &@<- chstr] + +type 'b supplier = unit -> 'b * Lexing.position * Lexing.position + +(** [ondemand_list_supplier ~pp ~eoi l] is a supplier that returns all tokens + obtained after pre-processing of [l] by [pp], and then [eoi]. *) +let ondemand_list_supplier (module Om: Src_overlay.MANAGER) ~pp ~eoi l = + let y_l = ref [] and l = ref l and prev_limit = ref None in + let rec aux () = + supply !y_l ~otherwise:begin fun () -> match !l with + | x :: tl -> + l := tl; + supply (pp x) ~otherwise:aux + | [] -> + let b = Option.value !prev_limit ~default:Om.dummy_limit in + eoi, b, b + end + and supply ~otherwise = function + | y :: y_tl -> + y_l := y_tl; + let s, e = Om.limits ~@y in + Option.iter (fun e -> Om.link_limits e s) !prev_limit; + prev_limit := Some e; + ~&y, s, e + | [] -> + otherwise () + in + aux + +let pptoks_of_text_supplier om text = + ondemand_list_supplier ~eoi:Preproc_tokens.EOL ~pp:pptoks_of_chstr om text + +(** Tokenize the given text into pptokens if it starts with a {!CDirWord}. *) +let supply_text_if_compiler_directive om = function + | t :: _ as text when Text.cdirp t -> + Ok (pptoks_of_text_supplier om text) + | _ -> + Error `NotCDir diff --git a/src/lsp/cobol_preproc/text_supplier.mli b/src/lsp/cobol_preproc/text_supplier.mli new file mode 100644 index 000000000..c059e648f --- /dev/null +++ b/src/lsp/cobol_preproc/text_supplier.mli @@ -0,0 +1,26 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** {2 Feeding the parser(s)} *) + +type 'b supplier = unit -> 'b * Lexing.position * Lexing.position + +val pptoks_of_text_supplier + : (module Src_overlay.MANAGER) + -> Text.t + -> Preproc_tokens.token supplier + +val supply_text_if_compiler_directive + : (module Src_overlay.MANAGER) + -> Text.t + -> (Preproc_tokens.token supplier, [> `NotCDir]) result diff --git a/src/lsp/cobol_preproc/text_types.ml b/src/lsp/cobol_preproc/text_types.ml new file mode 100644 index 000000000..2753e619f --- /dev/null +++ b/src/lsp/cobol_preproc/text_types.ml @@ -0,0 +1,53 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc + +(* The output of the preprocessor is a `text`, i.e. a list of words with + locations. *) + +type text = text_word with_loc list +and t = text (* alias *) +and text_word = + | TextWord of string (* upper-cased *) + | CDirWord of string (* upper-cased *) + | Alphanum of alphanum + | AlphanumPrefix of alphanum + | Pseudo of pseudotext + | Eof +and alphanum = + { + knd: literal_kind; + qte: quotation; + str: string; + } +and quotation = + | Quote + | Apostrophe +and literal_kind = + | Basic + | Bool | BoolX (* B, BX *) + | Hex (* X *) + | NullTerm (* Z (not ISO/IEC) *) + | National | NationalX (* N, NX *) +and pseudotext = + pseudoword list +and pseudoword = + pseudotok with_loc +and pseudotok = + | PseudoWord of pseudoword_item with_loc list (* upper-cased? *) + | PseudoAlphanum of alphanum +and pseudoword_item = + | PwText of string + | PwDelim of pseudotext_delimiter +and pseudotext_delimiter = string * Str.regexp (* with pre-built regexp *) diff --git a/src/vscode-json/version.mlt b/src/lsp/cobol_preproc/version.mlt similarity index 100% rename from src/vscode-json/version.mlt rename to src/lsp/cobol_preproc/version.mlt diff --git a/src/lsp/cobol_typeck/README.md b/src/lsp/cobol_typeck/README.md new file mode 100644 index 000000000..59fd0f930 --- /dev/null +++ b/src/lsp/cobol_typeck/README.md @@ -0,0 +1,5 @@ +# Cobol_typeck package + +This package contains data and type checking functions for COBOL. + +For API documentation, please see [index.mld]. diff --git a/src/lsp/cobol_typeck/cobol_typeck.ml b/src/lsp/cobol_typeck/cobol_typeck.ml new file mode 100644 index 000000000..e57ad041d --- /dev/null +++ b/src/lsp/cobol_typeck/cobol_typeck.ml @@ -0,0 +1,1175 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(** Type-checking and validation of COBOL compilation groups *) + +open Cobol_ast +open Cobol_common.Srcloc.INFIX +module DIAGS = Cobol_common.Diagnostics +module StrMap = Cobol_common.Basics.StrMap +module Visitor = Cobol_common.Visitor +module PTree_visitor = Cobol_parser.PTree_visitor +module CU = Cobol_data.Compilation_unit +module CUs = CU.SET + +module Make + (Config: Cobol_config.T) (* for dialect-based checks *) + (Diags: DIAGS.STATEFUL) = +struct + + + open Cobol_parser.PTree + + (* TODO: extract this into a Prog_env_initializer module? *) + let initialize_prog_env = + let valid_picture_symbol = function + | '0'..'9' | 'a'..'e' | 'A'..'E' | 'N' | 'P' | 'R' | 'S' | 'V' + | 'X' | 'Z' | 'n' | 'p' | 'r' | 's' | 'v' | 'x' | 'z' + | '+' | '-' | ',' | '.' | '/' | ';' | '(' | ')' | '=' + | '\'' |'"' | ' ' -> false + | 'L' | 'G' | 'l' | 'g' (* <- TODO: Check dialect for those *) + | _ -> true + in + let special_names_clause_folder = object + inherit [Cobol_data.PROG_ENV.t] PTree_visitor.folder + + method! fold_special_names_clause' { loc; payload = clause } env = + match clause with + | DecimalPointIsComma -> + Visitor.skip { env with decimal_point = ',' } + | CurrencySign { sign = (Alphanum s | National s); + picture_symbol = None } + | CurrencySign { picture_symbol = Some (Alphanum s | National s); _ } + when String.length s != 1 -> + Diags.error ~loc "%s@ is@ not@ a@ valid@ picture@ symbol." s; + Visitor.skip env + | CurrencySign { sign = Alphanum s | National s; + picture_symbol = None } + | CurrencySign { picture_symbol = Some (Alphanum s | National s); _ } + when not (valid_picture_symbol s.[0]) -> + Diags.error ~loc "%c@ is@ not@ a@ valid@ PICTURE@ symbol." s.[0]; + Visitor.skip env + | CurrencySign { sign = Alphanum s | National s; + picture_symbol = None } + | CurrencySign { picture_symbol = Some (Alphanum s | National s); _ } -> + Visitor.skip @@ + { env with + currency_signs = Cobol_data.CharSet.add s.[0] env.currency_signs } + | _ -> (* TODO: other clauses? *) + Visitor.proceed env (* may report unfinished visitor warnings *) + end in + fun env_div base_env -> + let env = + PTree_visitor.fold_environment_division'_opt special_names_clause_folder + env_div base_env + in + (* Currency sign defaults to '$' *) + if Cobol_data.CharSet.is_empty env.currency_signs + then { env with currency_signs = Cobol_data.CharSet.singleton '$' } + else env + + let try_making_env_of_compilation_unit, + try_making_env_of_program_unit + = + let build_env ?parent_env name env = + let prog_env = Cobol_data.PROG_ENV.make ?parent:parent_env ~&name in + Visitor.skip @@ Some (initialize_prog_env env prog_env) + in + let env_builder = object + inherit [Cobol_data.PROG_ENV.t option] PTree_visitor.folder + method! fold_program_unit p parent_env = + build_env p.program_name p.program_env ?parent_env + method! fold_function_unit f _ = + build_env f.function_name f.function_env + method! fold_method_definition m _ = + build_env m.method_name m.method_env + method! fold_class_definition' { payload = c; _ } _ = + build_env c.class_name c.class_env + method! fold_interface_definition' { payload = i; _ } _ = + build_env i.interface_name i.interface_env + method! fold_factory_definition _ = + Visitor.skip (* NOTE: only lacks a name *) + method! fold_instance_definition _ = + Visitor.skip (* NOTE: only lacks a name *) + end in + (fun cu' -> + PTree_visitor.fold_compilation_unit' env_builder cu' None), + (fun ~parents pu' -> + PTree_visitor.fold_program_unit' env_builder pu' + (match parents with h :: _ -> Some h | [] -> None)) + + let picture_of_string Cobol_data.PROG_ENV.{ decimal_point; + currency_signs; _ } s = + let module E = struct + let decimal_char = decimal_point + let currency_signs = currency_signs + end in + let module PIC = Cobol_data.Picture.Make (Config) (E) in + try PIC.of_string s with + | PIC.InvalidPicture (str, diags, dummy) -> + Diags.add_all diags; + dummy &@<- str + + + let validate_data_clauses = + Cobol_validation.validate_data_clauses (module Diags) + + (* For wss only for now; to be generalized once we have a proper data-group + structure. *) + let pictured_data_item_descrs_builder env = + let open Cobol_data.Pictured_ast in + + let convert_data_clauses clauses = + PTree_visitor.fold_data_clauses (object + inherit [_] PTree_visitor.folder + method! fold_data_clause' c acc = + let c' = match ~&c with + | DataPicture { payload = { picture; + picture_locale; + picture_depending }; loc } -> + let picture_clause = + { picture = picture_of_string env picture; + picture_locale; + picture_depending } in + Some (DataPicture (picture_clause &@ loc)) + | DataUsage u -> + Some (DataUsage u) + | _ -> (* TODO: map other data clauses *) + None + in + Visitor.skip (match c' with None -> acc | Some c' -> (c' &@<- c) :: acc) + end) clauses [] |> List.rev + in + + let rev_and_validate_data_item_descrs + : type k. k item_descr with_loc list -> k item_descr with_loc list + = fun rev_data_item_descrs -> + (* Associate each item with an `is_elementary` flag during reversal, and + then map the result again to obtain messages in order of + declarations. *) + + let _, flagged_data_item_descrs = + List.fold_left begin fun (next_level, acc) descr -> + let is_elementary curr_level = curr_level >= next_level in + match (~&descr: k item_descr) with + | Data { data_level; _ } when ~&data_level = 77 -> (* special noncontiguous item *) + 0, (descr, true) :: acc + | Data { data_level = { payload = l; _ }; _ } + | Renames { rename_level = {payload = 66 as l; _}; _ } + | Screen { screen_level = l; _ } + | ReportGroup { report_level = l; _ } -> + l, (descr, is_elementary l) :: acc + | Constant _ -> + 0, (descr, false) :: acc + | Renames _ -> (* force level 66- *) + 66, (descr, false) :: acc + | CondName _ -> + 88, (descr, false (* CHECKME: ??? *)) :: acc + end (0, []) rev_data_item_descrs + in + + List.map begin fun (descr, is_elementary) -> + match (~&descr: k item_descr) with + | Data { data_level = l; _ } when ~&l < 1 || (~&l > 49 && ~&l <> 77) -> + Diags.error ~loc:~@l "Invalid@ level@ %d@ for@ data@ item" ~&l; + descr + | Renames { rename_level = {payload = l; _}; _ } when l <> 66 -> + Diags.warn ~loc:~@descr "RENAMES@ data@ item@ should@ be@ at@ level@ 66"; + descr + | Data item -> + validate_data_clauses ~is_elementary (item &@<- descr); + descr + | _ -> (* TODO *) + descr + end flagged_data_item_descrs + in + + object + inherit [_] PTree_visitor.folder + + method! fold_working_storage_section _ acc = + (* We should only encounter one working-storage section. If we do, then + we are traversing a sub-program's working-storage section that we can + skip. *) + if acc = [] + then Visitor.do_children_and_then [] rev_and_validate_data_item_descrs + else Visitor.skip acc + + (* TODO: visit other sections (or skip and use other visitor objects for + sections to be treated differently. *) + method! fold_linkage_section _ = Visitor.skip (*TODO: This should be handled*) + + (* TODO: Visiting (is/should) be done in order of declarations. So, just + append to a data group under construction. *) + method! fold_data_item' { loc; payload = { data_level; + data_name; + data_clauses } } acc = + let mangle = Cobol_data.Mangling.mangle_data_name ~default_loc:loc in + let data_item = (* TODO: no need to mangle at this point *) + { data_level; data_name = mangle data_name; + data_clauses = convert_data_clauses data_clauses } in + Visitor.proceed ((Data data_item &@ loc) :: acc) + + (* TODO: fold_constant_item' *) + (* TODO: fold_rename_item' *) + (* TODO: fold_condition_name_item' *) + (* TODO: fold_screen_item' *) + (* TODO: fold_report_group_item' *) + end + + let data_of_compilation_unit', + data_of_program_unit' + = + let data_group_of_wss env = + let check_data_group dg = + Cobol_data.Typing.of_data_group (module Diags) env dg + in + fun wss -> + (*TODO: Better*) + match Cobol_data.Group.of_working_storage (module Diags) wss with + | Ok data_groups -> + List.filter_map + (fun dg -> match check_data_group dg with + | Ok _ -> Some dg + | Error _ -> None) data_groups + | Error _ -> [] + in + let data_of_compilation_unit' env u = + let data_items_checker = pictured_data_item_descrs_builder env in + let wss = PTree_visitor.fold_compilation_unit' data_items_checker u [] in + data_group_of_wss env wss + and data_of_program_unit' env p = + let data_items_checker = pictured_data_item_descrs_builder env in + let wss = PTree_visitor.fold_program_unit' data_items_checker p [] in + data_group_of_wss env wss + in + data_of_compilation_unit', + data_of_program_unit' + + let name_of_compilation_unit = function + | Program {program_name = name; _} + | Function {function_name = name; _} + | ClassDefinition {class_name = name; _} + | InterfaceDefinition {interface_name = name; _} -> ~&name + + (** Main entry for verification of compilation groups. This function checks + full groups and and builds their associated internal representation. *) + let typeck_compilation_group (compilation_group: compilation_group) = + + let visitor = object + inherit [Cobol_data.PROG_ENV.t list * CUs.t] PTree_visitor.folder + + method! fold_compilation_unit' cu ((parents, progs) as acc) = + match ~&cu with + | Program _ -> + (* Dealt with in `fold_program_unit'` below *) + Visitor.do_children acc + | Function _ | ClassDefinition _ | InterfaceDefinition _ -> + match try_making_env_of_compilation_unit cu with + | None -> + Visitor.skip acc + | Some cu_env -> + (* TODO (++): here we built an env for `u`. Transmit it to + another visitor to build the associated data-groups + directly (no need to bother with the "pictured" + representation; same for the representation of the + procedure division. *) + let cu_name = name_of_compilation_unit ~&cu + and cu_wss = data_of_compilation_unit' cu_env cu in + let prog = CU.{ cu_name; cu_loc = ~@cu; cu_env; cu_wss } in + Visitor.skip @@ (parents, CUs.add prog progs) + + method! fold_program_unit' pu ((parents, progs) as acc) = + match try_making_env_of_program_unit ~parents pu with + | None -> + Visitor.proceed acc + | Some cu_env -> + (* TODO: same as (++) above. *) + (* NB: For now we create an standalone CU (note the "C"), but we + should register nested PUs as children of their parents PUs + instead. *) + let cu_name = ~&(~&pu.program_name) + and cu_wss = data_of_program_unit' cu_env pu in + let prog = CU.{ cu_name; cu_loc = ~@pu; cu_env; cu_wss } in + let acc = cu_env :: parents, CUs.add prog progs in + (* Proceed with potential nested progs, and then restore stack of + parents: *) + Visitor.do_children_and_then acc (fun (_, progs) -> parents, progs) + + (* skip some divisions *) + method! fold_environment_division _ = Visitor.skip + method! fold_data_division' _ = Visitor.skip + method! fold_procedure_division' _ = Visitor.skip + end in + + PTree_visitor.fold_compilation_group visitor compilation_group + ([], CUs.empty) |> snd + +(* + let data_groups = DataGroup.of_working_storage (module Diags) mangled_wss in + + Fmt.pr "%a" Fmt.(result ~ok:DataGroup.pp_data_group_list ~error:(any "Error")) data_groups; + + let rec add_data_item qualname env data_group = + match data_group with + | DataGroup.Elementary {name; _} -> + let qualname = Qual (name, qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + { env with + data_items = QualMap.add qualname data_item env.data_items; } + | Group {name; elements; _} -> + let qualname = Qual (name, qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + let env = + { env with + data_items = QualMap.add qualname data_item env.data_items; } + in + List.fold_left (add_data_item qualname) env elements + | Renames {name; targets} -> + let targets = + List.fold_left (fun acc target -> + let target_name = DataGroup.name_of target in + Qual (target_name, qualname)::acc) + [] + targets + in + let data_item = CobolEnv.DATA_ITEM.make name in + let data_item = + {data_item with + renames = targets;} + in + let first_level_name = QualMap.QUAL_NAME.get_highest_level qualname in + let qn = Qual (name, Name first_level_name) in + { env with + data_items = QualMap.add qn data_item env.data_items; } + | ConditionName {name; values; target;} -> + let target = + Qual (DataGroup.name_of target, qualname) + in + let (condition: CobolEnv.DATA_ITEM.condition option) = Some {target; values;} in + let cond_name = Qual (name, qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + let data_item = + {data_item with + condition;} + in + { env with + data_items = QualMap.add cond_name data_item env.data_items; } + | Constant _ -> + let loc = DataGroup.name_location data_group in + Diags.error ~loc "These should be top level."; + env + in + + let env = + Result.fold + ~error:(fun _ -> env) + ~ok:(fun data_groups -> + List.fold_left (fun env data_group -> + match data_group with + | DataGroup.Elementary {name; _} -> + let qualname = (Name name: qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + { env with + data_items = QualMap.add qualname data_item env.data_items; } + | Group {name; elements; _} -> + let qualname = (Name name: qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + let env = + { env with + data_items = QualMap.add qualname data_item env.data_items; } + in + List.fold_left (add_data_item qualname) env elements + | Constant {name; value;} -> + let qualname = (Name name: qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + let data_item = + {data_item with + constant = Some value;} + in + {env with + data_items = QualMap.add qualname data_item env.data_items; } + | ConditionName {name; values; target;} -> + let target = + (Name (DataGroup.name_of target): qualname) + in + let (condition: CobolEnv.DATA_ITEM.condition option) = Some {target; values;} in + let cond_name = (Name name: qualname) in + let data_item = CobolEnv.DATA_ITEM.make name in + let data_item = + {data_item with + condition;} + in + { env with + data_items = QualMap.add cond_name data_item env.data_items; } + | _ -> + let loc = ~@(DataGroup.name_of data_group) in + Diags.error ~loc "These should not be top level."; + env + ) + env + data_groups) + data_groups + in + + (* REDEFINES must be directly after the group they redefine (modulo other + * REDEFINES), and must be of the same level number. + * If concerning level 01 item then can be of bigger length otherwise must be + * smaller or of same size. + * The redefined item cannot be qualified as the placement of the REDEFINES + * does not allow for ambiguity. *) + (* let _redefines = + let has_redefines = List.exists (function + | {payload = PicAST.Data_section.Redefines _; _} -> true + | _ -> false) + in + let rec get_redefines qualname redefines data_group = + match data_group with + | DataGroup.Elementary {data_desc; _} -> + if has_redefines ~&data_desc.data_description_clauses then + (qualname, data_desc)::redefines + else + redefines + | Group {name; elements; data_desc} -> + let redefines = + if has_redefines ~&data_desc.data_description_clauses then + (qualname, data_desc)::redefines + else + redefines + in + let new_qualname = + Option.fold + ~none:(Some (Name (name &@<- data_desc): qualname)) + ~some:(fun qn -> Some (Qual (name &@<- data_desc, qn))) + qualname + in + List.fold_left (get_redefines new_qualname) redefines elements + in + List.fold_left (fun redefines data_group -> + match data_group with + | DataGroup.Elementary {data_desc; _} -> + if has_redefines ~&data_desc.data_description_clauses then + (None, data_desc)::redefines + else + redefines + | Group {name; elements; data_desc} -> + let redefines = + if has_redefines ~&data_desc.data_description_clauses then + (None, data_desc)::redefines + else + redefines + in + List.fold_left (get_redefines ( Some (Name (name &@<- data_desc)))) + redefines + elements) + [] + in +*) + env +*) + + (* let data_types = + List.map (fun (prog_name, data_groups) -> + let prog_path = List.assoc prog_name prog_paths in + let prog_env = prog_env_of_path prog_name prog_path environment in + prog_name, + List.map begin function + | (DataGroup.Elementary (name, _) | Group (name, _, _)) as dg -> + name, Result.get_ok @@ TYPING.of_data_group (module Diags: Diagnostics.STATEFUL) prog_env dg, dg + end data_groups) + data_groups + in + + (* Adds type name and location to every data item in the environment*) + let environment = + ENV.mapi (fun prog_name prog_env -> + let data_items_funs = + {DATA_ITEM.fm_default with + data_item = (fun funs (name, typ, dg) data_item -> + (*The global clause only concerns the level 01 of the items. *) + let level1_name, dde = match dg with + | DataGroup.Elementary (name, dde) + | Group (name, _, dde) -> name, dde + in + let is_global = + (* TODO: extract this as a public predicate with a proper name *) + name = level1_name && + List.exists begin Cobol_common.Srcloc.payload >> function + | (Global: PicAST.Data_section.data_description_clause) -> true + | _ -> false + end ~&dde.data_description_clauses + in + let sub_items = match typ with + | Types.Elementary _ + | Table { payload = { typ = {elements_type = Elementary _; _}; _}; _ } -> + StringMap.empty + | Group { payload = { typ = fields; _}; _ } + | Table { payload = { typ = { + elements_type = Group { payload = {typ = fields; _}; _ }; _}; _; + }; _ } -> + List.fold_left + (fun sub_items ({field_type; field_name}) -> + let data_item, _ = + DATA_ITEM.fm_data_item + funs + (field_name, field_type, dg) + DATA_ITEM.empty + in + StringMap.add field_name data_item sub_items) + StringMap.empty + fields + | _ -> + failwith + "A table cannot directly contain a table type." + in + {data_item with + sub_items; + data_name = Some name; + loc = Some(Types.loc_of typ); + data_type = Some typ; + level_number = Types.level_of typ; + global = is_global; + }, (name, typ, dg)); + } + in + PROG_ENV.fm_prog_env + {PROG_ENV.fm_default with + prog_env = (fun funs (prog_name, data_types) prog_env -> + let prog_dg = List.assoc prog_name data_types in + let data_items = List.fold_left (fun data_items (name, typ, dg) -> + let data_item = + DATA_ITEM.fm_data_item + data_items_funs + (name, typ, dg) + DATA_ITEM.empty + |> fst + in + StringMap.add name data_item data_items) + StringMap.empty + prog_dg + in + let nested_progs = + StringMap.mapi (fun prog_name prog_env -> + PROG_ENV.prog_env funs (prog_name, data_types) prog_env + |> fst) + prog_env.nested_progs + in + {prog_env with + data_items; + nested_progs}, (prog_name, data_types)); + } + (prog_name, data_types) + prog_env + |> fst) + environment + in + + (* Calculate the data items size*) + let environment = + ENV.map (fun prog_env -> + let data_item_funs = + {DATA_ITEM.fm_default with + data_type = (fun _ (size, _) data_type -> + data_type, + match data_type with + | Some (Elementary { payload = _, Some pic; _ }) -> + size + pic.size, None + | Some (Table { payload = { + typ = { elements_type = Elementary { payload = _, Some pic; _ }; + length; }; _; }; _ }) -> + let pic_size = pic.size in + let length = + Int64.to_int @@ match length with + | Fixed l -> l + | OccursDepending {max_size; _} -> + max_size + in + size + (length * pic_size), None + | Some (Table { payload = { typ = { length; _}; _}; _ }) -> + let length = + Int64.to_int @@ match length with + | Fixed l -> l + | OccursDepending {max_size; _} -> + max_size + in + size, Some length + | _ -> size, None); + sub_items = (fun funs (size, tab_length) sub_items -> + let sub_items, sub_size, _ = + StringMap.fold + (fun data_name data_item (sub_items, size, tab_length) -> + let sub_item, (sub_size, _) = + DATA_ITEM.fm_data_item funs (0, None) data_item + in + let tab_mult = Option.value ~default:1 tab_length in + StringMap.add data_name sub_item sub_items, + (tab_mult * sub_size) + size, + tab_length) + sub_items + (StringMap.empty, 0, tab_length) + in + sub_items, (size + sub_size, tab_length)); + data_size = (fun _ (size, _) _ -> + size, (size, None)) + } + in + PROG_ENV.fm_prog_env + {PROG_ENV.fm_default with + data_items = (fun _ _ data_items -> + StringMap.map (fun data_item -> + DATA_ITEM.fm_data_item data_item_funs (0, None) data_item + |> fst) + data_items, + ()); + nested_progs = (fun funs _ nested_progs -> + StringMap.map (fun nested_prog -> + PROG_ENV.fm_prog_env funs () nested_prog + |> fst) + nested_progs, + ()); + } + () + prog_env + |> fst) + environment + in + + (* We add the data items from a containing program to its nested programs + * TODO: Add a flag in prog_env saying that the item is from upper level + * program. *) + let environment = + ENV.map + begin + PROG_ENV.fm_prog_env + {PROG_ENV.fm_default with + prog_env = (fun funs acc prog_env -> + let data_items, acc = + PROG_ENV.data_items funs acc prog_env.data_items + in + let nested_progs, acc = + PROG_ENV.nested_progs funs acc prog_env.nested_progs + in + {prog_env with + data_items; + nested_progs; + }, acc); + data_items = (fun _ acc data_items -> + let union = + StringMap.merge (fun _ (e1: DATA_ITEM.t option) e2 -> + match e1,e2 with + | None, None -> None + | Some e1, None -> + if e1.global then + Some e1 + else + None + | Some _, Some e2 + | None, Some e2 -> Some e2) + acc + data_items + in + union, union); + nested_progs = (fun funs acc nested_progs -> + StringMap.map (fun nested_prog -> + PROG_ENV.fm_prog_env funs acc nested_prog + |> fst) + nested_progs, acc) + } + StringMap.empty + >> fst + end + environment + in + + (* Add toplevel items and warn about qualification *) + let environment = + let data_item_funs = + {DATA_ITEM.fm_default with + data_name = (fun _ ((prog_env: PROG_ENV.t), removed) data_name -> + match data_name with + | Some name -> + if StringSet.mem name prog_env.toplevel_items then + data_name, + ({prog_env with + toplevel_items = + StringSet.remove name prog_env.toplevel_items; + }, + StringSet.add name removed) + else if StringSet.mem name removed then + data_name, (prog_env, removed) + else + data_name, + ({prog_env with + toplevel_items = + StringSet.add name prog_env.toplevel_items; + }, + removed) + | None -> + failwith "The data name should be mangled at this point."); + sub_items = (fun funs acc sub_items -> + StringMap.fold (fun key sub_item (sub_items, acc) -> + let sub_item, acc = DATA_ITEM.fm_data_item funs acc sub_item in + StringMap.add key sub_item sub_items, acc) + sub_items + (StringMap.empty, acc)); + } + in + + ENV.map + (fun prog_env -> + PROG_ENV.fm_prog_env + {PROG_ENV.fm_default with + data_items = (fun _ (prog_env, _) data_items -> + let prog_env, removed = + StringMap.fold (fun _ data_item (prog_env, removed) -> + let prog_env, removed = + DATA_ITEM.fm_data_item + data_item_funs + (prog_env, removed) + data_item + |> snd + in + prog_env, removed) + data_items + (prog_env, StringSet.empty) + in + data_items, (prog_env, removed)) + } + (prog_env, StringSet.empty) + prog_env + |> Pair.map_snd + ~f:(Pair.map_snd + ~f:(StringSet.iter @@ Diags.warn + "Data-name@ `%s'@ is@ bound@ to@ several@ items;@ use@ of@ \ + qualification@ is@ recommended")) + |> fst) + environment + in + + (* Add data item paths *) + let data_item_funs = + {DATA_ITEM.fm_default with + data_name = (fun _ (parent_path, _, sub_item_paths, _) data_name -> + let name = match data_name with + | Some name -> name + | None -> failwith "All the data names should be mangled" + in + let sub_item_paths = + match parent_path with + | [] -> + sub_item_paths + | _ -> + StringMap.add name parent_path sub_item_paths + in + data_name, (parent_path, name, sub_item_paths, StringMap.empty)); + sub_items = + (fun funs (parent_path, curr_name, sub_item_paths, _) sub_items -> + let sub_items, new_sub_items_paths = + StringMap.fold + (fun sub_name sub_item (sub_items, sub_items_paths) -> + let sub_item, (_, _, sub_item_paths, _) = + DATA_ITEM.fm_data_item + funs + ([curr_name], "", sub_items_paths, sub_items_paths) + sub_item + in + StringMap.add sub_name sub_item sub_items, sub_item_paths) + sub_items + (StringMap.empty, StringMap.empty) + in + let sub_item_paths = + StringMap.merge (fun _ path sub_item_path -> + match path, sub_item_path with + | None, None -> None + | Some e1, None -> Some e1 + | None, Some e2 -> Some ((List.rev parent_path)@e2) + | Some _, Some _ -> None) + sub_item_paths + new_sub_items_paths + in + sub_items, + (parent_path, curr_name, sub_item_paths, new_sub_items_paths)); + sub_items_paths = (fun _ (parent_path, name, paths, sub_item_paths) _ -> + let sub_item_paths = StringMap.filter_map (fun _ path -> + match path with + | [] -> failwith "Look into it" + | _::[] -> None + | _::parent -> Some parent) + sub_item_paths + in + sub_item_paths, (parent_path, name, paths, sub_item_paths)); + } + in + + let environment = + ENV.map + begin + PROG_ENV.fm_prog_env + {PROG_ENV.fm_default with + prog_env = (fun _ _ prog_env -> + let data_items, data_item_paths = + StringMap.fold + (fun data_name data_item (data_items, paths) -> + let data_item, (_, _, paths, _) = + DATA_ITEM.fm_data_item + data_item_funs + ([], "", paths, StringMap.empty) + data_item + in + StringMap.add data_name data_item data_items, paths) + prog_env.data_items + (StringMap.empty, StringMap.empty) + in + {prog_env with + data_items; + data_item_paths; + }, ()) + } + () + >> fst + end + environment + in + + let rec replace_from_path (env: PROG_ENV.t ENV.t) path new_prog_env = + match path with + | prog_name::[] -> ENV.replace prog_name new_prog_env env + | parent_name::rest -> + let parent_env = match ENV.find_opt parent_name env with + | Some e -> e + | None -> Fmt.failwith "Cannot find environment for %s" parent_name (* again???? *) + in + let nested_progs = + replace_from_path parent_env.nested_progs rest new_prog_env + in + ENV.replace parent_name {parent_env with nested_progs} env + | [] -> failwith"The path to the program environment must not be empty" (* argh.... *) + in + + (* Add redefines *) + (*TODO: Add redefines validation, ie: They are at the same level as the + redefined item and their size can be bigger only if they concern + level 1 items. *) + let environment = + (* TODO: Stil way too long; factorize all of this. *) + List.fold_left (fun env (prog_name, redef_list) -> + let prog_env_path = List.assoc prog_name prog_paths in + let prog_env = prog_env_of_path prog_name prog_env_path env in + let prog_env = + let open PicAST in + let lookup_name (dde: Data_section.dde with_loc) = + match ~&(~&dde.data_name) with + | Some (Name name) -> ~&name + (* TODO: get rid of this failwith *) + | _ -> failwith "All name should be mangled" + and lookup_redefine dde = + let redef = + List.find begin function + | { payload = Data_section.Redefines _; _ } -> true + | _ -> false + end dde + in + match redef with + | { payload = Redefines rd; _ } -> Some ~&rd + (* TODO: get rid of this failwith *) + | _ -> failwith "This must be a redefine" + and replace_subitem name sub_item + ({ sub_items; _ } as data_item: DATA_ITEM.t) = + { data_item with sub_items = StringMap.replace name sub_item sub_items } + in + List.fold_left begin fun prog_env (path, redef_dde) -> + let data_item_funs = + {DATA_ITEM.fm_default with + data_item = + fun funs (path, (redef_dde: Data_section.dde with_loc)) data_item -> + match path with + | name :: tl -> + let sub_item, _ = + StringMap.find name data_item.sub_items + |> DATA_ITEM.fm_data_item funs (tl, redef_dde) + in + replace_subitem name sub_item data_item, (path, redef_dde) + | [] -> + let name = lookup_name redef_dde in + let sub_item = + { (StringMap.find name data_item.sub_items) with + redefines = + lookup_redefine ~&redef_dde.data_description_clauses } + in + replace_subitem name sub_item data_item, (path, redef_dde) + } + in + fst @@ PROG_ENV.fm_prog_env + {PROG_ENV.fm_default with + data_items = fun _ _ data_items -> + match path with + | name :: tl -> + let data_item, _ = + StringMap.find name data_items + |> DATA_ITEM.fm_data_item data_item_funs (tl, redef_dde) + in + StringMap.replace name data_item data_items, () + | [] -> + let name = lookup_name redef_dde in + let data_item = + { (StringMap.find name data_items) with + redefines = + lookup_redefine ~&redef_dde.data_description_clauses } + in + StringMap.replace name data_item data_items, () + } + () + prog_env + end prog_env redef_list + in + replace_from_path env (prog_env_path@[prog_name]) prog_env) + environment + redefines + in + + (* Get the type of renames entry. *) + let renames_types = + List.map (fun (prog_name, renames_list) -> + let prog_env_path = List.assoc prog_name prog_paths in + let prog_env = prog_env_of_path prog_name prog_env_path environment in + prog_name, + List.fold_left + (fun acc (dde_before, (rename: rename_entry with_loc)) -> + let dde_before = + DataGroup.of_data_description_entries dde_before + |>begin function + | hd::[] -> hd + | _ -> failwith "There must be only one data group before a rename" + end + in + (dde_before, + ~&rename.data_name, + TYPING.of_rename_entry prog_env dde_before rename, + rename)::acc) + [] + renames_list + |> List.rev) + renames + in + + (* Add the renames entry to the environment. *) + let environment = + List.fold_left (fun env (prog_name, renames_types) -> + let prog_env_path = List.assoc prog_name prog_paths in + let prog_env = prog_env_of_path prog_name prog_env_path env in + List.fold_left + (fun (prog_env: PROG_ENV.t) (dde_before, name, typ, renames) -> + let renames_range = match typ with + | Elementary _ -> + [~&renames.renamed_item] + | Group g -> + List.map (fun f -> (Name (f.field_name &@<- g): qualname)) (~&g).typ + | _ -> + failwith "RENAMES cannot be a table" + in + let name = ~&name in + let data_item = + {DATA_ITEM.empty with + data_name = Some name; + data_type = Some typ; + loc = Some (~@renames); + renames = renames_range; + } + in + let DataGroup.Elementary (level1_name, _) + | Group (level1_name, _, _) = + dde_before + in + let level1_item = StringMap.find level1_name prog_env.data_items in + let new_level1 = + {level1_item with + sub_items = StringMap.add name data_item level1_item.sub_items + } + in + {prog_env with + data_items = + StringMap.replace level1_name new_level1 prog_env.data_items; + toplevel_items = + if StringSet.mem name prog_env.toplevel_items then + StringSet.remove name prog_env.toplevel_items + else + StringSet.add name prog_env.toplevel_items; + data_item_paths = + StringMap.add name [level1_name] prog_env.data_item_paths; + }) + prog_env + renames_types + |> replace_from_path env (prog_env_path@[prog_name])) + environment + renames_types + in + + (* Add the condition names to the environment *) + let _environment = + List.fold_left + (fun env (prog_name, cond_entry_list) -> + let prog_env_path = List.assoc prog_name prog_paths in + let prog_env = prog_env_of_path prog_name prog_env_path env in + List.fold_left + (fun (prog_env: PROG_ENV.t) (dde_before, cond_entry) -> + let data_group = + match DataGroup.of_data_description_entries dde_before with + | hd::[] -> hd + | _ -> + failwith + "There must be only one data group before a condition name" + in + let last_item_path = DataGroup.last_item_path data_group in + let name = ~&(~&cond_entry.condition_name) in + let cond_entry_item = + {DATA_ITEM.empty with + data_name = Some name; + loc = Some ~@cond_entry; + data_type = Some (Types.Elementary (({ + typ = Conditional; + level = 88L; + }, None) &@<- cond_entry)); + } + in + let add_renames_funs = + {DATA_ITEM.fm_default with + data_item = (fun funs (path, cond_name, cond_entry) data_item -> + match path with + | [] -> + {data_item with + sub_items = + StringMap.add cond_name cond_entry data_item.sub_items; + }, + (path, cond_name, cond_entry) + | hd::tl -> + (* As the conditional variables do not contains any + data but are just a filler for a test, we do not + need to change the type of the data item it is contained + in. *) + let sub_item = + DATA_ITEM.fm_data_item + funs + (tl, cond_name, cond_entry) + @@ StringMap.find hd data_item.sub_items + |> fst + in + {data_item with + sub_items = + StringMap.replace hd sub_item data_item.sub_items; + }, + (path, cond_name, cond_entry)); + } + in + let level1_name = List.hd last_item_path in + let new_data_item = + DATA_ITEM.fm_data_item + add_renames_funs + (List.tl last_item_path, name, cond_entry_item) + @@ StringMap.find level1_name prog_env.data_items + |> fst + in + {prog_env with + data_items = + StringMap.replace level1_name new_data_item prog_env.data_items; + }) + prog_env + cond_entry_list + |> replace_from_path env (prog_env_path@[prog_name])) + environment + cond_names + in + + (*TODO(emilien): Learn to build pretty printer*) + (*IGNORE ME*) + let data_item_printer = + { DATA_ITEM.fm_default with + data_name = + (fun _funs _ data_name -> + let dn = match data_name with + | Some dn -> dn + | None -> "None" + in + data_name, (dn, [])); + sub_items = (fun funs acc sub_items -> + let sub_items = StringMap.map (fun item -> + fst (DATA_ITEM.fm_data_item funs ("", []) item)) + sub_items in + sub_items, acc); + renames = (fun _funs (dn, _) renames -> + renames, (dn, renames)); + redefines = (fun _funs (dn, renames) redefines -> + let redef = match redefines with + | None -> "None" + | Some redef -> redef + in + Format.fprintf + Format.std_formatter + "(Item: %s; Redefines: %s; Renames: %s;)\n" + dn + redef + ([%derive.show: qualname list] renames); + redefines, (dn, renames)) + } + in + + let _prog_env_printer = + let open Format in + {PROG_ENV.fm_default with + name = (fun _ acc name -> + for _ = 0 to (2 * acc) do + printf " " + done; + printf "Program ID: %a\n" (pp_print_option pp_print_string) name; + name, acc); + nested_progs = (fun funs acc nested_progs -> + if not @@ StringMap.is_empty nested_progs then + begin + for _ = 0 to (2 * acc) do + printf " " + done; + printf "with nested programs:\n" + end; + StringMap.iter (fun _ nested_env -> + ignore @@ PROG_ENV.prog_env funs (acc + 1) nested_env) + nested_progs; + nested_progs, acc); + data_items = (fun _ acc data_items -> + StringMap.iter (fun _ data_item -> + ignore + @@ DATA_ITEM.fm_data_item data_item_printer ("", []) data_item) + data_items; + data_items, acc) + } + in + Ok (file_env, Cobol_common.Diagnostics.Set.none) +*) +end + +let analyze_compilation_group ?(config = Cobol_config.default) + (type m) : m Cobol_parser.parsed_compilation_group -> _ = + + let analyze_cg (module Diags: DIAGS.STATEFUL) cg = + let module Typeck = Make (val config) (Diags) in + Ok (Typeck.typeck_compilation_group cg, DIAGS.Set.none) + in + function + | { parsed_output = Only None | WithTokens (None, _, _); + parsed_diags; _ } -> + Error parsed_diags + | { parsed_output = Only Some cg | WithTokens (Some cg, _, _); + parsed_diags; _ } -> + match Cobol_common.catch_diagnostics analyze_cg cg with + | Ok (res, diags) -> + Ok (res, cg, DIAGS.Set.union parsed_diags diags) + | Error diags -> + Error (DIAGS.Set.union parsed_diags diags) diff --git a/src/lsp/cobol_typeck/cobol_typeck.mli b/src/lsp/cobol_typeck/cobol_typeck.mli new file mode 100644 index 000000000..b25129591 --- /dev/null +++ b/src/lsp/cobol_typeck/cobol_typeck.mli @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module DIAGS = Cobol_common.Diagnostics +module StrMap = Cobol_common.Basics.StrMap +module Visitor = Cobol_common.Visitor +module PTree_visitor = Cobol_parser.PTree_visitor +module CUs = Cobol_data.Compilation_unit.SET + +val analyze_compilation_group + : ?config:(module Cobol_config.T) + -> _ Cobol_parser.parsed_compilation_group + -> (CUs.t * Cobol_parser.PTree.compilation_group * DIAGS.diagnostics, + DIAGS.diagnostics) + result + +module Make + (Config: Cobol_config.T) (* for dialect-based checks *) + (Diags: DIAGS.STATEFUL) : sig + val try_making_env_of_compilation_unit: + Cobol_parser.PTree.compilation_unit Cobol_common.Srcloc.TYPES.with_loc -> + Cobol_data.PROG_ENV.t option +end diff --git a/src/lsp/cobol_typeck/cobol_validation.ml b/src/lsp/cobol_typeck/cobol_validation.ml new file mode 100644 index 000000000..aa97a6f8a --- /dev/null +++ b/src/lsp/cobol_typeck/cobol_validation.ml @@ -0,0 +1,102 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES +open Cobol_data.Pictured_ast.Data_sections + +exception SemanticError of string * srcloc + +(* This follows the 85 standard and IBM dialect specification. *) +(* TODO: accept a `data_item with_loc` instead *) +let validate_data_clauses + (module Diags: Cobol_common.Diagnostics.STATEFUL) + ?(is_elementary = false) + ({ payload = { data_clauses; _ }; loc }: data_item with_loc) + = + (* This does not generalize well to other mutual exclusion constraints. + + TODO: Instead, we should accumulate locations of clauses and do single + mutual exclusion checks at the end. *) + let has_usage = ref false in + let has_usage_index = ref false in + let has_usage_pointer = ref false in + let has_usage_function_pointer = ref false in + let has_usage_procedure_pointer = ref false in + let has_usage_object_reference = ref false in + let has_picture_clause = ref false in + List.iter begin fun { payload = clause; loc } -> match clause with + | DataBlankWhenZero when not is_elementary -> + Diags.error ~loc "BLANK-WHEN-ZERO clause is forbidden in non elementary \ + data item" + | DataJustified when not is_elementary -> + Diags.error ~loc "JUSTIFIED clause is forbidden in non elementary data \ + item" + | DataPicture _ when not is_elementary -> + Diags.error ~loc "PICTURE clause is forbidden in non elementary data item" + | DataPicture _ -> + has_picture_clause := true; + if !has_usage_index then + Diags.error ~loc "PICTURE clause is forbidden when USAGE INDEX is \ + specified"; + if !has_usage_pointer then + Diags.error ~loc "PICTURE clause is forbidden when USAGE POINTER is \ + specified"; + if !has_usage_function_pointer then + Diags.error ~loc "PICTURE clause is forbidden when USAGE \ + FUNCTION-POINTER is specified"; + if !has_usage_procedure_pointer then + Diags.error ~loc "PICTURE clause is forbidden when USAGE \ + PROCEDURE-POINTER is specified"; + if !has_usage_object_reference then + Diags.error ~loc "PICTURE clause is forbidden when USAGE OBJECT \ + REFERENCE is specified"; + | DataSynchronized _ when not is_elementary -> + Diags.error ~loc "SYNCHRONIZED clause is forbidden in non elementary \ + data item" + | DataUsage _ when !has_usage -> + Diags.error ~loc "Only one USAGE clause is allowed." + | DataUsage usage_clause -> + has_usage := true; + begin match usage_clause with + | Index when !has_picture_clause -> + Diags.error ~loc "USAGE INDEX clause is forbidden when PICTURE is \ + specified" + | Pointer _ when !has_picture_clause -> + Diags.error ~loc "USAGE POINTER clause is forbidden when PICTURE \ + is specified" + | FunctionPointer _ when !has_picture_clause -> + Diags.error ~loc "USAGE FUNCTION-POINTER clause is forbidden when \ + PICTURE is specified" + | ProgramPointer _ when !has_picture_clause -> + Diags.error ~loc "USAGE PROCEDURE-POINTER clause is forbidden when \ + PICTURE is specified" + | ObjectReference _ when !has_picture_clause -> + Diags.error ~loc "USAGE OBJECT REFERENCE clause is forbidden when \ + PICTURE is specified" + | Index -> + has_usage_index := true + | Pointer _ -> + has_usage_pointer := true + | FunctionPointer _ -> + has_usage_function_pointer := true + | ProgramPointer _ -> + has_usage_procedure_pointer := true + | ObjectReference _ -> + has_usage_object_reference := true + | _ -> () + end + | _ -> () + end data_clauses; + if is_elementary && not !has_picture_clause && not !has_usage then + Diags.error ~loc "There must be either a PICTURE or a USAGE clause in an \ + elementary item description" diff --git a/src/lsp/cobol_typeck/cobol_validation.mli b/src/lsp/cobol_typeck/cobol_validation.mli new file mode 100644 index 000000000..8bd119fca --- /dev/null +++ b/src/lsp/cobol_typeck/cobol_validation.mli @@ -0,0 +1,20 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Cobol_common.Srcloc.TYPES + +exception SemanticError of string * srcloc + +val validate_data_clauses : + (module Cobol_common.Diagnostics.STATEFUL) -> ?is_elementary:bool -> + Cobol_data.Pictured_ast.data_item with_loc -> unit diff --git a/src/lsp/cobol_typeck/dune b/src/lsp/cobol_typeck/dune new file mode 100644 index 000000000..9b9c25af8 --- /dev/null +++ b/src/lsp/cobol_typeck/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name cobol_typeck) + (public_name cobol_typeck) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ppx_deriving cobol_parser cobol_data cobol_common cobol_ast ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_deriving.show)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package cobol_typeck)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/cobol_typeck/grouped_ast.ml b/src/lsp/cobol_typeck/grouped_ast.ml new file mode 100644 index 000000000..c81099ca2 --- /dev/null +++ b/src/lsp/cobol_typeck/grouped_ast.ml @@ -0,0 +1,69 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Misc_sections = + Cobol_ast.Raw.Misc_sections +module Data_sections = struct + include Cobol_data.Pictured_ast.Data_sections + type working_storage_section = Cobol_data.Group.t list [@@deriving show] + type linkage_section = Cobol_data.Group.t list [@@deriving show] +end +module Data_division = + Cobol_ast.Raw.Data_division (Data_sections) +module Statements = + Cobol_ast.Raw.Statements +module Proc_division = + Cobol_ast.Raw.Proc_division (Statements) +module Compilation_group = + Cobol_ast.Raw.Compilation_group + (Misc_sections) (Data_division) (Proc_division) + +include Compilation_group +include Proc_division +include Statements +include Data_division +include Cobol_data.Pictured_ast.Picture +include Cobol_data.Pictured_ast.Data_sections +include Cobol_data.Pictured_ast.Misc_sections + +(* +module Data_div_mapper = struct + open Pictured_ast.Data_div + let data_entries = List.filter_map begin function + | Pictured_ast.Data_section.{ payload = Data d; _ } as cdde -> + Some (d &@<- cdde) + | _ -> None + end + let file_section (fs: file_section) = (fs: Data_div_repr.file_section) + (* TODO: Replace module here *) + let working_storage_section (wss: working_storage_section) = + Result.get_ok @@ DataGroup.of_working_storage (module Cobol_common.Diagnostics.InitStateful ()) wss + let linkage_section ls = + Result.get_ok @@ DataGroup.of_working_storage (module Cobol_common.Diagnostics.InitStateful ()) ls + let communication_section = Fun.id + let local_storage_section = Fun.id + let report_section = Fun.id + let screen_section = Fun.id +end + +module Data_div_traversal = Traversal.Make_data_div_traversal + (Pictured_ast.Data_div) (Grouped_data_div_ast) (Data_div_mapper) + +module Pictured_to_grouped_traversal = + Traversal.Make (Pictured_ast) (Grouped_ast) (struct + let picture = Fun.id + include Data_div_mapper + end) + +module Grouped_ast_traversal = Traversal.MakeId (Grouped_ast) +*) diff --git a/src/lsp/cobol_typeck/index.mld b/src/lsp/cobol_typeck/index.mld new file mode 100644 index 000000000..c57167123 --- /dev/null +++ b/src/lsp/cobol_typeck/index.mld @@ -0,0 +1,9 @@ +{1 Library cobol_typeck} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package contains data and type checking functions on COBOL data items. + +The entry point of this library is the module: {!Cobol_typeck}. + diff --git a/src/lsp/cobol_typeck/mangling.ml b/src/lsp/cobol_typeck/mangling.ml new file mode 100644 index 000000000..867c63882 --- /dev/null +++ b/src/lsp/cobol_typeck/mangling.ml @@ -0,0 +1,220 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* open Cobol_common.Basics *) +(* open Cobol_typing.CobolEnv *) +(* open Cobol_ast.INFIX *) + +(*FIXME: Rework on the entire module *) + +module Mangler = struct + type t = { + mangled_name: string; + original_name: string; + } + + type env = + | Elem of t + | Grp of t * env list + + let _count = ref 0 + let _last_buf = ref 0 + let new_buf_name () = + incr _count; + _last_buf := !_count; + Format.sprintf "b_%i" (!_count) + + let last_buf_name () = + Format.sprintf "b_%i" (!_last_buf) + + let new_field_name () = + incr _count; + Format.sprintf "f_%i" (!_count) + + exception Found of t + + let rec find name env = + match env with + | Elem ({original_name; _} as m) -> + if original_name = name then + m + else + raise Not_found + | Grp ({original_name; _} as m, subs) -> + if original_name = name then + raise @@ Found m + else + let rec aux = function + | [] -> raise Not_found + | hd::tl -> try + find name hd + with Not_found -> + aux tl + in + aux subs + +end + +(* +module GAst_trav = Grouped_ast.Grouped_ast_traversal + +(* let mangling_traversal_funs = + let open Cobol_typing.DataGroup in + let open Cobol_typing.CobolEnv.PROG_ENV in + let open Cobol_typing.CobolEnv.DATA_ITEM in + let rec sub_items_mangling buf (data_items: DATA_ITEM.t StringMap.t) = function + | Elementary {name; data_desc} -> + let data_item = StringMap.find ~&name data_items in + let new_name = Mangler.new_field_name () in + (* Format.printf "Buf: %s Field: %s For: %s\n" buf new_name name; *) + let data_items = StringMap.add + ~&(data_item.name) + {data_item with c_buf = buf; c_field = new_name} + data_items + in + data_items, Elementary (name, dde) + | Group (name, dgl, dde) -> + let data_item = StringMap.find name data_items in + let new_name = Mangler.new_field_name () in + (* Format.printf "Buf: %s Field: %s For: %s\n" buf new_name name; *) + let sub_items, dgl = List.fold_left_map (sub_items_mangling buf) data_item.sub_items dgl in + let data_item = {data_item with c_buf = buf; c_field = new_name; sub_items;} in + let data_items = + StringMap.replace (Option.get data_item.data_name) data_item data_items + in + data_items, Group (name, dgl, dde) + in + let data_div_traversal_funs stage = + GAst_trav.{Data_div_traversal.fm_default with + working_storage_section = (fun _funs prog_env wss -> + let prog_env, wss = + List.fold_left_map (fun (prog_env: PROG_ENV.t) dg -> + let dg, prog_env = match dg with + | Elementary (name, dde) -> + (* Format.printf "Buf: %s Field: %s For: %s\n" new_name new_field name; *) + let data_item = if stage = `Working then + ENV.find name prog_env.data_items + else + ENV.find name prog_env.linkage_items + in + let new_name = if Option.is_none data_item.redefines then + Mangler.new_buf_name () + else + Mangler.last_buf_name () + in + let new_field = if Option.is_none data_item.redefines then + "f_"^(String.sub new_name 2 ((String.length new_name) - 2)) + else + Mangler.new_field_name () + in + begin + match stage with + | `Working -> + let prog_env = + {prog_env with + data_items = + ENV.replace + (Option.get data_item.data_name) + {data_item with c_buf = new_name; c_field = new_field} + prog_env.data_items + } + in + Elementary (name, dde), prog_env + | `Linkage -> + let prog_env = + {prog_env with + linkage_items = + ENV.replace + (Option.get data_item.data_name) + {data_item with c_buf = new_name; c_field = new_field} + prog_env.linkage_items + } + in + Elementary (name, dde), prog_env + end + | Group (name, dgl, dde) -> + (* Format.printf "Buf: %s Field: %s For: %s\n" new_name new_field name; *) + let data_item = if stage = `Working then + ENV.find name prog_env.data_items + else + ENV.find name prog_env.linkage_items + in + let new_name = if Option.is_none data_item.redefines then + Mangler.new_buf_name () + else + Mangler.last_buf_name () + in + let new_field = if Option.is_none data_item.redefines then + "f_"^(String.sub new_name 2 ((String.length new_name) - 2)) + else + Mangler.new_field_name () + in + match stage with + | `Working -> + let sub_items, dgl = List.fold_left_map (sub_items_mangling new_name) data_item.sub_items dgl in + let data_item = {data_item with c_buf = new_name; c_field = new_field; sub_items} in + let prog_env = + {prog_env with + data_items = + ENV.replace + (Option.get data_item.data_name) + data_item + prog_env.data_items + } + in + Group (name, dgl, dde), prog_env + | `Linkage -> + let sub_items, dgl = List.fold_left_map (sub_items_mangling new_name) data_item.sub_items dgl in + let data_item = {data_item with c_buf = new_name; c_field = new_field; sub_items} in + let prog_env = + {prog_env with + linkage_items = + ENV.replace + (Option.get data_item.data_name) + data_item + prog_env.linkage_items + } + in + Group (name, dgl, dde), prog_env + in + prog_env, dg) + prog_env + wss + in + wss, prog_env) + } + in + GAst_trav.{fm_default with + program_definition = (fun funs env pd -> + let name = ~&(pd.program_id_paragraph.program_name) in + let prog_env = ENV.find name env in + let data_division, prog_env = + (pd.data_division, prog_env) + >>= GAst_trav.Data_div_traversal.fm_data_division + {(data_div_traversal_funs `Working) with + linkage_section = (data_div_traversal_funs `Linkage).working_storage_section} + in + let nested_env = prog_env.nested_progs in + let nested_env, nested_programs = + List.fold_left_map (fun nested_env nested_prog -> + fm_program_definition funs nested_env ~&nested_prog + |> Pair.map_fst ~f:(fun np -> np &@<- nested_prog) + |> Pair.swap) + nested_env + pd.nested_programs + in + let env = ENV.replace name {prog_env with nested_progs = nested_env} env in + {pd with data_division; nested_programs}, env + ); + } *) +*) diff --git a/src/lsp/cobol_typeck/package.toml b/src/lsp/cobol_typeck/package.toml new file mode 100644 index 000000000..147eb4f35 --- /dev/null +++ b/src/lsp/cobol_typeck/package.toml @@ -0,0 +1,78 @@ + +# name of package +name = "cobol_typeck" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_deriving.show" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_ast = "version" +cobol_common = "version" +cobol_data = "version" +cobol_parser = "version" +ppx_deriving = ">=5.2.1" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/vscode-languageclient-js-stubs/version.mlt b/src/lsp/cobol_typeck/version.mlt similarity index 100% rename from src/vscode-languageclient-js-stubs/version.mlt rename to src/lsp/cobol_typeck/version.mlt diff --git a/src/lsp/ebcdic_lib/README.md b/src/lsp/ebcdic_lib/README.md new file mode 100644 index 000000000..f34268b1c --- /dev/null +++ b/src/lsp/ebcdic_lib/README.md @@ -0,0 +1,4 @@ +# Ebcdic_lib package + +This package contains functions to translate EBCDIC characters to ASCII characters and ASCII characters +to EBCDIC characters. diff --git a/src/lsp/ebcdic_lib/dune b/src/lsp/ebcdic_lib/dune new file mode 100644 index 000000000..9e36cdf75 --- /dev/null +++ b/src/lsp/ebcdic_lib/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name ebcdic_lib) + (public_name ebcdic_lib) + (wrapped false) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + + + ) + + +(rule + (targets ebcdic_version.ml) + (deps (:script ebcdic_version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package ebcdic_lib)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/ebcdic_lib/ebcdic.ml b/src/lsp/ebcdic_lib/ebcdic.ml new file mode 100644 index 000000000..7baf6a79b --- /dev/null +++ b/src/lsp/ebcdic_lib/ebcdic.ml @@ -0,0 +1,658 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* +// Copyright 2017 Rohit Joshi +// +// Licensed under the Apache License, Version 2.0 or the MIT license +// , at your +// option. This file may not be copied, modified, or distributed +// except according to those terms. +*) + +let to_ascii = [| + 0x00 ; + 0x01 ; + 0x02 ; + 0x03 ; + 0x85 ; + 0x09 ; + 0x86 ; + 0x7f ; (* 00-0f: *) + 0x87 ; + 0x8d ; + 0x8e ; + 0x0b ; + 0x0c ; + 0x0d ; + 0x0e ; + 0x0f ; (* ................ *) + 0x10 ; + 0x11 ; + 0x12 ; + 0x13 ; + 0x8f ; + 0x0a ; + 0x08 ; + 0x97 ; (* 10-1f: *) + 0x18 ; + 0x19 ; + 0x9c ; + 0x9d ; + 0x1c ; + 0x1d ; + 0x1e ; + 0x1f ; (* ................ *) + 0x80 ; + 0x81 ; + 0x82 ; + 0x83 ; + 0x84 ; + 0x92 ; + 0x17 ; + 0x1b ; (* 20-2f: *) + 0x88 ; + 0x89 ; + 0x8a ; + 0x8b ; + 0x8c ; + 0x05 ; + 0x06 ; + 0x07 ; (* ................ *) + 0x90 ; + 0x91 ; + 0x16 ; + 0x93 ; + 0x94 ; + 0x95 ; + 0x96 ; + 0x04 ; (* 30-3f: *) + 0x98 ; + 0x99 ; + 0x9a ; + 0x9b ; + 0x14 ; + 0x15 ; + 0x9e ; + 0x1a ; (* ................ *) + 0x20 ; + 0xa0 ; + 0xe2 ; + 0xe4 ; + 0xe0 ; + 0xe1 ; + 0xe3 ; + 0xe5 ; (* 40-4f: *) + 0xe7 ; + 0xf1 ; + 0xa2 ; + 0x2e ; + 0x3c ; + 0x28 ; + 0x2b ; + 0x7c ; (* ...........<(+| *) + 0x26 ; + 0xe9 ; + 0xea ; + 0xeb ; + 0xe8 ; + 0xed ; + 0xee ; + 0xef ; (* 50-5f: *) + 0xec ; + 0xdf ; + 0x21 ; + 0x24 ; + 0x2a ; + 0x29 ; + 0x3b ; + 0x5e ; (* &.........!$*/;^ *) + 0x2d ; + 0x2f ; + 0xc2 ; + 0xc4 ; + 0xc0 ; + 0xc1 ; + 0xc3 ; + 0xc5 ; (* 60-6f: *) + 0xc7 ; + 0xd1 ; + 0xa6 ; + 0x2c ; + 0x25 ; + 0x5f ; + 0x3e ; + 0x3f ; (* -/......... ;%_>? *) + 0xf8 ; + 0xc9 ; + 0xca ; + 0xcb ; + 0xc8 ; + 0xcd ; + 0xce ; + 0xcf ; (* 70-7f: *) + 0xcc ; + 0x60 ; + 0x3a ; + 0x23 ; + 0x40 ; + 0x27 ; + 0x3d ; + 0x22 ; (* .........`:#@\'="" *) + 0xd8 ; + 0x61 ; + 0x62 ; + 0x63 ; + 0x64 ; + 0x65 ; + 0x66 ; + 0x67 ; (* 80-8f: *) + 0x68 ; + 0x69 ; + 0xab ; + 0xbb ; + 0xf0 ; + 0xfd ; + 0xfe ; + 0xb1 ; (* .abcdefghi...... *) + 0xb0 ; + 0x6a ; + 0x6b ; + 0x6c ; + 0x6d ; + 0x6e ; + 0x6f ; + 0x70 ; (* 90-9f: *) + 0x71 ; + 0x72 ; + 0xaa ; + 0xba ; + 0xe6 ; + 0xb8 ; + 0xc6 ; + 0xa4 ; (* .jklmnopqr...... *) + 0xb5 ; + 0x7e ; + 0x73 ; + 0x74 ; + 0x75 ; + 0x76 ; + 0x77 ; + 0x78 ; (* a0-af: *) + 0x79 ; + 0x7a ; + 0xa1 ; + 0xbf ; + 0xd0 ; + 0x5b ; + 0xde ; + 0xae ; (* .~stuvwxyz...[.. *) + 0xac ; + 0xa3 ; + 0xa5 ; + 0xb7 ; + 0xa9 ; + 0xa7 ; + 0xb6 ; + 0xbc ; (* b0-bf: *) + 0xbd ; + 0xbe ; + 0xdd ; + 0xa8 ; + 0xaf ; + 0x5d ; + 0xb4 ; + 0xd7 ; (* .............].. *) + 0x7b ; + 0x41 ; + 0x42 ; + 0x43 ; + 0x44 ; + 0x45 ; + 0x46 ; + 0x47 ; (* c0-cf: *) + 0x48 ; + 0x49 ; + 0xad ; + 0xf4 ; + 0xf6 ; + 0xf2 ; + 0xf3 ; + 0xf5 ; (* {ABCDEFGHI...... *) + 0x7d ; + 0x4a ; + 0x4b ; + 0x4c ; + 0x4d ; + 0x4e ; + 0x4f ; + 0x50 ; (* d0-df: *) + 0x51 ; + 0x52 ; + 0xb9 ; + 0xfb ; + 0xfc ; + 0xf9 ; + 0xfa ; + 0xff ; (* }JKLMNOPQR...... *) + 0x5c ; + 0xf7 ; + 0x53 ; + 0x54 ; + 0x55 ; + 0x56 ; + 0x57 ; + 0x58 ; (* e0-ef: *) + 0x59 ; + 0x5a ; + 0xb2 ; + 0xd4 ; + 0xd6 ; + 0xd2 ; + 0xd3 ; + 0xd5 ; (* \.STUVWXYZ...... *) + 0x30 ; + 0x31 ; + 0x32 ; + 0x33 ; + 0x34 ; + 0x35 ; + 0x36 ; + 0x37 ; (* f0-ff: *) + 0x38 ; + 0x39 ; + 0xb3 ; + 0xdb ; + 0xdc ; + 0xd9 ; + 0xda ; + 0x9f (* 0123456789...... *) ; + |] + + +let of_ascii = [| + 0x00 ; + 0x01 ; + 0x02 ; + 0x03 ; + 0x37 ; + 0x2d ; + 0x2e ; + 0x2f ; (* 00-0f: *) + 0x16 ; + 0x05 ; + 0x15 ; + 0x0b ; + 0x0c ; + 0x0d ; + 0x0e ; + 0x0f ; (* ................ *) + 0x10 ; + 0x11 ; + 0x12 ; + 0x13 ; + 0x3c ; + 0x3d ; + 0x32 ; + 0x26 ; (* 10-1f: *) + 0x18 ; + 0x19 ; + 0x3f ; + 0x27 ; + 0x1c ; + 0x1d ; + 0x1e ; + 0x1f ; (* ................ *) + 0x40 ; + 0x5a ; + 0x7f ; + 0x7b ; + 0x5b ; + 0x6c ; + 0x50 ; + 0x7d ; (* 20-2f: *) + 0x4d ; + 0x5d ; + 0x5c ; + 0x4e ; + 0x6b ; + 0x60 ; + 0x4b ; + 0x61 ; (* !""#$%&'()*+ ;-./ *) + 0xf0 ; + 0xf1 ; + 0xf2 ; + 0xf3 ; + 0xf4 ; + 0xf5 ; + 0xf6 ; + 0xf7 ; (* 30-3f: *) + 0xf8 ; + 0xf9 ; + 0x7a ; + 0x5e ; + 0x4c ; + 0x7e ; + 0x6e ; + 0x6f ; (* 0123456789:;<=>? *) + 0x7c ; + 0xc1 ; + 0xc2 ; + 0xc3 ; + 0xc4 ; + 0xc5 ; + 0xc6 ; + 0xc7 ; (* 40-4f: *) + 0xc8 ; + 0xc9 ; + 0xd1 ; + 0xd2 ; + 0xd3 ; + 0xd4 ; + 0xd5 ; + 0xd6 ; (* @ABCDEFGHIJKLMNO *) + 0xd7 ; + 0xd8 ; + 0xd9 ; + 0xe2 ; + 0xe3 ; + 0xe4 ; + 0xe5 ; + 0xe6 ; (* 50-5f: *) + 0xe7 ; + 0xe8 ; + 0xe9 ; + 0xad ; + 0xe0 ; + 0xbd ; + 0x5f ; + 0x6d ; (* PQRSTUVWXYZ[\]^_ *) + 0x79 ; + 0x81 ; + 0x82 ; + 0x83 ; + 0x84 ; + 0x85 ; + 0x86 ; + 0x87 ; (* 60-6f: *) + 0x88 ; + 0x89 ; + 0x91 ; + 0x92 ; + 0x93 ; + 0x94 ; + 0x95 ; + 0x96 ; (* `abcdefghijklmno *) + 0x97 ; + 0x98 ; + 0x99 ; + 0xa2 ; + 0xa3 ; + 0xa4 ; + 0xa5 ; + 0xa6 ; (* 70-7f: *) + 0xa7 ; + 0xa8 ; + 0xa9 ; + 0xc0 ; + 0x4f ; + 0xd0 ; + 0xa1 ; + 0x07 ; (* pqrstuvwxyz{ | }~. *) + 0x20 ; + 0x21 ; + 0x22 ; + 0x23 ; + 0x24 ; + 0x04 ; + 0x06 ; + 0x08 ; (* 80-8f: *) + 0x28 ; + 0x29 ; + 0x2a ; + 0x2b ; + 0x2c ; + 0x09 ; + 0x0a ; + 0x14 ; (* ................ *) + 0x30 ; + 0x31 ; + 0x25 ; + 0x33 ; + 0x34 ; + 0x35 ; + 0x36 ; + 0x17 ; (* 90-9f: *) + 0x38 ; + 0x39 ; + 0x3a ; + 0x3b ; + 0x1a ; + 0x1b ; + 0x3e ; + 0xff ; (* ................ *) + 0x41 ; + 0xaa ; + 0x4a ; + 0xb1 ; + 0x9f ; + 0xb2 ; + 0x6a ; + 0xb5 ; (* a0-af: *) + 0xbb ; + 0xb4 ; + 0x9a ; + 0x8a ; + 0xb0 ; + 0xca ; + 0xaf ; + 0xbc ; (* ................ *) + 0x90 ; + 0x8f ; + 0xea ; + 0xfa ; + 0xbe ; + 0xa0 ; + 0xb6 ; + 0xb3 ; (* b0-bf: *) + 0x9d ; + 0xda ; + 0x9b ; + 0x8b ; + 0xb7 ; + 0xb8 ; + 0xb9 ; + 0xab ; (* ................ *) + 0x64 ; + 0x65 ; + 0x62 ; + 0x66 ; + 0x63 ; + 0x67 ; + 0x9e ; + 0x68 ; (* c0-cf: *) + 0x74 ; + 0x71 ; + 0x72 ; + 0x73 ; + 0x78 ; + 0x75 ; + 0x76 ; + 0x77 ; (* ................ *) + 0xac ; + 0x69 ; + 0xed ; + 0xee ; + 0xeb ; + 0xef ; + 0xec ; + 0xbf ; (* d0-df: *) + 0x80 ; + 0xfd ; + 0xfe ; + 0xfb ; + 0xfc ; + 0xba ; + 0xae ; + 0x59 ; (* ................ *) + 0x44 ; + 0x45 ; + 0x42 ; + 0x46 ; + 0x43 ; + 0x47 ; + 0x9c ; + 0x48 ; (* e0-ef: *) + 0x54 ; + 0x51 ; + 0x52 ; + 0x53 ; + 0x58 ; + 0x55 ; + 0x56 ; + 0x57 ; (* ................ *) + 0x8c ; + 0x49 ; + 0xcd ; + 0xce ; + 0xcb ; + 0xcf ; + 0xcc ; + 0xe1 ; (* f0-ff: *) + 0x70 ; + 0xdd ; + 0xde ; + 0xdb ; + 0xdc ; + 0x8d ; + 0x8e ; + 0xdf (* ................ *) ; + |] + +let non_printable = [| + 0x00 ; + 0x01 ; + 0x02 ; + 0x03 ; + 0x9C ; + 0x09 ; + 0x86 ; + 0x7F ; + 0x97 ; + 0x8D ; + 0x8E ; + 0x0B ; + 0x0C ; + 0x0D ; + 0x0E ; + 0x0F ; + 0x10 ; + 0x11 ; + 0x12 ; + 0x13 ; + 0x9D ; + 0x85 ; + 0x08 ; + 0x87 ; + 0x18 ; + 0x19 ; + 0x92 ; + 0x8F ; + 0x1C ; + 0x1D ; + 0x1E ; + 0x1F ; + 0x80 ; + 0x81 ; + 0x82 ; + 0x83 ; + 0x84 ; + 0x0A ; + 0x17 ; + 0x1B ; + 0x88 ; + 0x89 ; + 0x8A ; + 0x8B ; + 0x8C ; + 0x05 ; + 0x06 ; + 0x07 ; + 0x90 ; + 0x91 ; + 0x16 ; + 0x93 ; + 0x94 ; + 0x95 ; + 0x96 ; + 0x04 ; + 0x98 ; + 0x99 ; + 0x9A ; + 0x9B ; + 0x14 ; + 0x15 ; + 0x9E ; + 0x1A ; + 0x20 ; + 0xA0 ; + |] + +let non_printable = + let t = Array.make 256 false in + Array.iter (fun c -> + t.( c ) <- true + ) non_printable ; + t + +let ebcdic_NEL = 0x15 + +let ebcdic_to_ascii + ?(non_printable_to_space=false) + ?(nel_to_lf=false) + src = + let len = String.length src in + let dst = Bytes.create len in + for i = 0 to len-1 do + + let c = src.[i] in + let c = int_of_char c in + let b = + if nel_to_lf && c == ebcdic_NEL then + '\n' + else + if non_printable_to_space && non_printable.( c ) then + ' ' + else + char_of_int to_ascii.( c ) + in + Bytes.set dst i b + done; + dst + +let ascii_to_ebcdic ?(lf_to_nel=false) src = + let len = String.length src in + let dst = Bytes.create len in + for i = 0 to len-1 do + + let c = src.[i] in + let b = + if lf_to_nel && c == '\n' then + ebcdic_NEL + else + of_ascii.( int_of_char c ) + in + Bytes.set dst i ( char_of_int b ) + done; + dst diff --git a/src/lsp/ebcdic_lib/ebcdic.mli b/src/lsp/ebcdic_lib/ebcdic.mli new file mode 100644 index 000000000..90e987b10 --- /dev/null +++ b/src/lsp/ebcdic_lib/ebcdic.mli @@ -0,0 +1,30 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* +// Copyright 2017 Rohit Joshi +// +// Licensed under the Apache License, Version 2.0 or the MIT license +// , at your +// option. This file may not be copied, modified, or distributed +// except according to those terms. +*) + +val to_ascii : int array +val of_ascii : int array +val non_printable : bool array + +val ebcdic_to_ascii : + ?non_printable_to_space:bool -> ?nel_to_lf:bool -> string -> bytes +val ascii_to_ebcdic : ?lf_to_nel:bool -> string -> bytes diff --git a/src/vscode-package-json/version.mlt b/src/lsp/ebcdic_lib/ebcdic_version.mlt similarity index 100% rename from src/vscode-package-json/version.mlt rename to src/lsp/ebcdic_lib/ebcdic_version.mlt diff --git a/src/lsp/ebcdic_lib/index.mld b/src/lsp/ebcdic_lib/index.mld new file mode 100644 index 000000000..c9f565d58 --- /dev/null +++ b/src/lsp/ebcdic_lib/index.mld @@ -0,0 +1,11 @@ +{1 Library ebcdic_lib} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package contains functions to translate EBCDIC characters to ASCII characters and ASCII characters +to EBCDIC characters. + +This library exposes the following toplevel modules: +{!modules:Ebcdic} + diff --git a/src/lsp/ebcdic_lib/package.toml b/src/lsp/ebcdic_lib/package.toml new file mode 100644 index 000000000..3b975af70 --- /dev/null +++ b/src/lsp/ebcdic_lib/package.toml @@ -0,0 +1,74 @@ + +# name of package +name = "ebcdic_lib" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "ebcdic_version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +# preprocess = "pps ppx_deriving_encoding" + +# files to skip while updating at package level +skip = ["main.ml", "index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +# ... + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/ebcdic_lib/version.mlt b/src/lsp/ebcdic_lib/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/lsp/ebcdic_lib/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/lsp/ppx_cobcflags/README.md b/src/lsp/ppx_cobcflags/README.md new file mode 100644 index 000000000..9ff0caec8 --- /dev/null +++ b/src/lsp/ppx_cobcflags/README.md @@ -0,0 +1,5 @@ +# Ppx_cobcflags package + +This package contains ppx rewriters to generate the cobc cli flags in `superbol`. To see which +rewriters are provided and what they are generating, please look at the package documentation which +gives a few use cases. diff --git a/src/lsp/ppx_cobcflags/dune b/src/lsp/ppx_cobcflags/dune new file mode 100644 index 000000000..c83abf32a --- /dev/null +++ b/src/lsp/ppx_cobcflags/dune @@ -0,0 +1,20 @@ +; generated by drom from package skeleton 'driver' +(library + (name main) + (public_name ppx_cobcflags) + (kind ppx_rewriter) + (libraries ppxlib ) + (preprocess (pps ppxlib.metaquot)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package ppx_cobcflags)) + + diff --git a/src/lsp/ppx_cobcflags/flag.ml b/src/lsp/ppx_cobcflags/flag.ml new file mode 100644 index 000000000..c703950c1 --- /dev/null +++ b/src/lsp/ppx_cobcflags/flag.ml @@ -0,0 +1,75 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ppxlib +open Ast_builder.Default + +let expand_flag on ~loc ~path:_ flag_name flag_args = + match flag_args with + | [{pexp_desc = Pexp_constant (Pconst_string (n, nloc, _)); _}; + {pexp_desc = Pexp_constant (Pconst_string (_, docsloc, _) as docs_cst); _}] -> + let flag_pat = ppat_var ~loc flag_name in + let flag_val = Located.lident ~loc:flag_name.loc flag_name.txt |> pexp_ident ~loc in + let flag_str = pexp_constant ~loc:nloc (Pconst_string ("f"^n, nloc, None)) in + let flag_no_str = pexp_constant ~loc:nloc (Pconst_string ("fno-"^n, nloc, None)) in + let docs_str = pexp_constant ~loc:docsloc docs_cst in + let arg_set = [%expr Arg.Set [%e flag_val]] in + let arg_unset = [%expr Arg.Clear [%e flag_val]] in + let default_value = if on then [%expr true] else [%expr false] in + let set_help = if on then [%expr "see " ^ [%e flag_no_str]] else docs_str in + let unset_help = if not @@ on then [%expr "see " ^ [%e flag_str]] else docs_str in + [%stri + let [%p flag_pat] = + let [%p flag_pat] = ref [%e default_value] in + let args = [ + [[%e flag_str]], + [%e arg_set], + EZCMD.info + [%e set_help]; + [[%e flag_no_str]], + [%e arg_unset], + EZCMD.info [%e unset_help] + ] in + all_gnucobol_args := args @ !all_gnucobol_args; + [%e flag_val], args] + | _ -> + [] |> + pstr_extension ~loc @@ + Location.error_extensionf ~loc + "Expecting a tuple of format (string, string)" + +let extension_flag = + Extension.declare "flag" + Extension.Context.structure_item + Ast_pattern.(pstr + (pstr_value + nonrecursive + (value_binding + ~pat:(ppat_var __') + ~expr:(pexp_tuple __) + ^::nil) + ^:: nil)) + (expand_flag false) + +let extension_flag_on = + Extension.declare "flag_on" + Extension.Context.structure_item + Ast_pattern.(pstr + (pstr_value + nonrecursive + (value_binding + ~pat:(ppat_var __') + ~expr:(pexp_tuple __) + ^::nil) + ^:: nil)) + (expand_flag true) diff --git a/src/lsp/ppx_cobcflags/flag_rq.ml b/src/lsp/ppx_cobcflags/flag_rq.ml new file mode 100644 index 000000000..b55628e6c --- /dev/null +++ b/src/lsp/ppx_cobcflags/flag_rq.ml @@ -0,0 +1,134 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ppxlib +open Ast_builder.Default + +let get_symbols loc flag_name fields = + let ctors, strs = + List.fold_left (fun (ctors, strs) field -> + match field.prf_desc with + | Rtag ({txt = n; loc} , true, []) -> + let name = Located.mk ~loc n in + let args = Pcstr_tuple [] in + let ctor = constructor_declaration ~loc ~name ~args ~res:None in + let str_cst = Pconst_string (n, loc, None) in + (ctor::ctors, str_cst::strs) + | _ -> failwith "Invalid variant") + ([], []) + fields + in + let variant = Ptype_variant (ctors) in + let type_decl = + type_declaration ~loc ~name:flag_name ~params:[] ~cstrs:[] ~kind:variant ~private_:Public + ~manifest:None + in + let cases = + List.rev @@ case ~lhs:(ppat_any ~loc) ~guard:None ~rhs:[%expr failwith "Invalid case"] + :: List.fold_left2 (fun cases ctor cst -> + let loc = ctor.pcd_loc in + let lhs = ppat_constant ~loc cst in + let lident = Located.lident ~loc ctor.pcd_name.txt in + let rhs = pexp_construct ~loc lident None in + case ~lhs ~guard:None ~rhs :: cases) + [] + ctors + strs + in + let match_expr = pexp_match ~loc [%expr arg] cases in + let flag_val = Located.lident ~loc:flag_name.loc flag_name.txt |> pexp_ident ~loc in + let symbols = List.fold_left (fun list cst -> + let cst_expr = pexp_constant ~loc cst in + [%expr [%e cst_expr]::[%e list]]) + [%expr []] + strs + in + let arg_set = [%expr + Arg.Symbol ([%e symbols], fun arg -> [%e flag_val] := [%e match_expr]) + ] + in + pstr_type ~loc Recursive [type_decl], arg_set + +let get_arg_type flag_name {txt = flag_type; loc} flag_val = + match flag_type with + | [%type: int] -> + None, [%expr Arg.Set_int [%e flag_val]] + | [%type: string] -> + None, [%expr Arg.Set_string [%e flag_val]] + | {ptyp_desc = Ptyp_variant (fields, Closed, None); ptyp_loc = loc; _ } -> + let type_decl, arg_set = get_symbols loc flag_name fields in + Some (type_decl), + arg_set + | _ -> None, + pexp_extension ~loc @@ + Location.error_extensionf ~loc "Type not handled yet" + +let expand_flag_rq ~loc ~path:_ flag_name flag_type params = + match params with + | [{pexp_desc = Pexp_constant (Pconst_string (n, nloc, _)); _}; + default_exp; + {pexp_desc = Pexp_constant ((Pconst_string (_, docv_loc, _)) as docv_cst); _}; + {pexp_desc = Pexp_constant ((Pconst_string (_, docs_loc, _)) as docs_cst); _};] -> + let flag_pat = ppat_var ~loc flag_name in + let flag_val = Located.lident ~loc:flag_name.loc flag_name.txt |> pexp_ident ~loc in + let flag_str = pexp_constant ~loc:nloc (Pconst_string ("f"^n, nloc, None)) in + let docv_str = pexp_constant ~loc:docv_loc docv_cst in + let docs_str = pexp_constant ~loc:docs_loc docs_cst in + let _arg_type, arg_set = get_arg_type flag_name flag_type flag_val in + let arg_type = None in + begin match arg_type with + | None -> + [%stri + let [%p flag_pat] = + let [%p flag_pat] = ref [%e default_exp] in + let args = [ + [[%e flag_str]], + [%e arg_set], + EZCMD.info ~docv:[%e docv_str] + [%e docs_str] + ] in + all_gnucobol_args := args @ !all_gnucobol_args; + [%e flag_val], args] + | Some type_decl -> + [%stri include struct + [%%i type_decl] + let [%p flag_pat] = + let [%p flag_pat] = ref [%e default_exp] in + let args = [ + [[%e flag_str]], + [%e arg_set], + EZCMD.info ~docv:[%e docv_str] + [%e docs_str] + ] in + all_gnucobol_args := args @ !all_gnucobol_args; + [%e flag_val], args + end] + end + | _ -> + [] |> + pstr_extension ~loc @@ + Location.error_extensionf ~loc + "Expecting a tuple of format (string, , string, string)" + +let extension_flag_rq = + Extension.declare "flag_rq" + Extension.Context.structure_item + Ast_pattern.(pstr + (pstr_value + nonrecursive + (value_binding + ~pat:(ppat_constraint (ppat_var __') __') + ~expr:(pexp_tuple __) + ^::nil) + ^:: nil)) + expand_flag_rq diff --git a/src/lsp/ppx_cobcflags/index.mld b/src/lsp/ppx_cobcflags/index.mld new file mode 100644 index 000000000..e0bb6c885 --- /dev/null +++ b/src/lsp/ppx_cobcflags/index.mld @@ -0,0 +1,8 @@ +{1 Program ppx_cobcflags} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package contains ppx rewriters to generate the cobc cli flags in [superbol]. To see which +rewriters are provided, and what they generate, please look at the {!Superbol.Gnucobol_args} +documentation. diff --git a/src/lsp/ppx_cobcflags/main.ml b/src/lsp/ppx_cobcflags/main.ml new file mode 100644 index 000000000..422df8658 --- /dev/null +++ b/src/lsp/ppx_cobcflags/main.ml @@ -0,0 +1,21 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ppxlib + +let rule_flag_rq = Context_free.Rule.extension Flag_rq.extension_flag_rq +let rule_flag = Context_free.Rule.extension Flag.extension_flag +let rule_flag_on = Context_free.Rule.extension Flag.extension_flag_on + +let () = + Driver.register_transformation "ppx_cobcflags" ~rules:[rule_flag_rq; rule_flag; rule_flag_on] diff --git a/src/lsp/ppx_cobcflags/package.toml b/src/lsp/ppx_cobcflags/package.toml new file mode 100644 index 000000000..febc275db --- /dev/null +++ b/src/lsp/ppx_cobcflags/package.toml @@ -0,0 +1,74 @@ + +# name of package +name = "ppx_cobcflags" +skeleton = "ppx_rewriter" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppxlib.metaquot" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +ppxlib = ">=0.15" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/ppx_cobcflags/version.mlt b/src/lsp/ppx_cobcflags/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/lsp/ppx_cobcflags/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/lsp/pretty/README.md b/src/lsp/pretty/README.md new file mode 100644 index 000000000..465fddc00 --- /dev/null +++ b/src/lsp/pretty/README.md @@ -0,0 +1,6 @@ +# Pretty package + +This library defines various types and functions for pretty printing. It is a slightly abstracted +version of [fmt] with renamed bindings. + +For API documentation see [index.mld]. diff --git a/src/lsp/pretty/dune b/src/lsp/pretty/dune new file mode 100644 index 000000000..d5d981b91 --- /dev/null +++ b/src/lsp/pretty/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name pretty) + (public_name pretty) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries fmt.tty ez_file ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package pretty)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/pretty/index.mld b/src/lsp/pretty/index.mld new file mode 100644 index 000000000..424201af0 --- /dev/null +++ b/src/lsp/pretty/index.mld @@ -0,0 +1,10 @@ +{1 Library pretty} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This library defines various types and functions for pretty printing. It is a slightly abstracted +version of {!fmt} with renamed bindings. + +The entry point of this library is the module: {!Pretty}. + diff --git a/src/lsp/pretty/package.toml b/src/lsp/pretty/package.toml new file mode 100644 index 000000000..170e8ce88 --- /dev/null +++ b/src/lsp/pretty/package.toml @@ -0,0 +1,77 @@ + +# name of package +name = "pretty" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +# preprocess = "pps ppx_deriving_encoding" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +ez_file = ">=0.3" +[dependencies.fmt] +libname = "fmt.tty" +version = ">=0.9" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/pretty/pretty.ml b/src/lsp/pretty/pretty.ml new file mode 100644 index 000000000..74d7766ec --- /dev/null +++ b/src/lsp/pretty/pretty.ml @@ -0,0 +1,191 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +module Types = struct + + (** Type of constant format strings for effect-full formatters. *) + type simple = (unit, Format.formatter, unit) format + + (** Type of functions that use a format string with ['a] arguments to return a + ['b]. *) + type ('a, 'b) func = ('a, Format.formatter, unit, 'b) format4 -> 'a + + (** Type of procedures that use a format string with ['a] arguments. *) + type 'a proc = ('a, Format.formatter, unit) format -> 'a + + (** Type of functions that apply an effect-full formatter to pretty-print a + value of type ['a]. *) + type 'a printer = Format.formatter -> 'a -> unit + + (** Type of functions that use a formatter to produce some pretty-printed + result. *) + type 'a formatting = Format.formatter -> 'a + + (** Type of functions that trigger an application of a fromatter. *) + type delayed = unit formatting + +end + +include Types + +(* --- *) + +(** [print] is a synonym for {!Format.fprintf}. *) +let print: Format.formatter -> 'a proc = Fmt.pf + +(** [out] is a synonym for {!Format.printf}. *) +let out: 'a proc = Fmt.pr + +(** [error] is a synonym for {!Format.eprintf}. *) +let error: 'a proc = Fmt.epr + +(** [delayed] is a synonym for {!Format.dprintf}. *) +let delayed: ('a, delayed) func = Format.dprintf + +(** [delayed_to] is a synonym for {!Format.kdprintf}. *) +let delayed_to: (delayed -> 'b) -> ('a, 'b) func = Format.kdprintf + +(** Sets right margin to given column (which must be > 2) *) +let pp_set_margin ppf margin = + Format.pp_set_geometry ppf ~max_indent:(pred margin) ~margin + +(** Sends right margin to virtual infinity *) +let blast_margin ppf = (* see https://github.com/ocaml/ocaml/issues/10592 *) + pp_set_margin ppf max_int + +(** Version of {!Format.asprintf} with virtually no right margin *) +let to_string: ('a, string) func = fun fmt -> + Fmt.str ("%t"^^fmt) blast_margin + +(** Version of {!Format.kasprintf} with virtually no right margin *) +let string_to: (string -> 'b) -> ('a, 'b) func = fun k fmt -> + Fmt.kstr k ("%t"^^fmt) blast_margin + +(** Shorhand for {!string_to} {!failwith}: [failwith] raises {!Failure} based on + the format string [fmt] (possibly with arguments). *) +let failwith fmt = + string_to failwith fmt + +(** [invalid_arg fmt] raises {!Invalid_argument} based on the format string + [fmt] (possibly with arguments). *) +let invalid_arg fmt = + string_to (fun s -> raise @@ Invalid_argument s) fmt + +(** [styles [s1, ... , sn]] is a shorthand equivalent of [Fmt.styled s1 @@ + Fmt.styled ... @@ Fmt.styled sn]. *) +let styles styles pp = + List.fold_left (fun pp s -> Fmt.styled s pp) pp styles + +(* --- *) + +module Simple = struct + (** Utilities to construct simple format strings from values. *) + + let from_format ?(map = Fun.id) format_string = + string_to (fun s -> Scanf.format_from_string (map s) "") format_string + + (** [int i] constructs a {!simple} format string as the decimal representation + of [i]. *) + let int: int -> simple = from_format "%d" + + (** [char c] constructs a {!simple} format string as the representation of + [c]. *) + let char: char -> simple = from_format "%c" + + (** [string s] constructs a {!simple} format string as the representation of + [s] ({i i.e.}, the resulting format string simply instructs to print the + given string). *) + let string: string -> simple = from_format "%s" + + (** [map f format] applies [f] on a string representation of [format], and + re-constructs a format string from the result. *) + let map f = from_format ~map:f "@[%(%)@]" + +end + +(* --- *) + +(* Here we add only those we use somewhere in the project (for now --- we could + at some point also include {!Fmt}) *) +(* include Fmt *) +let char: char printer = Fmt.char +let string: string printer = Fmt.string +let text: string printer = Fmt.text +let int64: int64 printer = Fmt.int64 + +let option: 'a printer -> 'a option printer = Fmt.option + +(* (\** [fmt fmt ppf] is a function that uses [ppf] to pretty-prints arguments *) +(* according to the format string [fmt]. It is equivalent to [Format.fprintf *) +(* ppf fmt]. *\) *) +(* let fmt: ('a, Format.formatter, unit) format -> 'a formatting = Fmt.fmt *) + +(** [list ?fopen ?fsep ?fclose ?fempty pp_elt ppf list] pretty-prints a list of + elements using the given simple format strings as delimiters and + separators. *) +let list + ?(fopen: simple = "[@[") + ?(fsep: simple = ",@ ") + ?(fclose: simple = "@]]") + ?(fempty: simple option) + : 'a printer -> 'a list printer + = fun pp_e ppf lst -> + let empty = + List.fold_left begin fun first e -> + (if first then Fmt.fmt fopen else Fmt.fmt fsep) ppf; pp_e ppf e; false + end true lst + in + if empty + then match fempty with + | None -> Fmt.pf ppf "%(%)%(%)" fopen fclose + | Some fempty -> Fmt.pf ppf fempty + else Fmt.pf ppf fclose + +(** [stack ppf s] pretty-prints a "stack" encoded as a list using a traditional + layout in some formal-method literature: an empty stack is "[]", otherwise + the elements are given as a "::"-separated list of elements, starting from + the top. *) +let stack: 'a printer -> 'a list printer = fun s -> + list ~fopen:"" ~fsep:"::" ~fclose:"" ~fempty:"[]" s + +(** [path ppf strings] uses [ppf] to print the list of strings [strings] as a + path (typically, colon-separated on Unix-style systems). *) +let path = + list string ~fopen:"" ~fclose:"" ~fempty:"" + ~fsep:(Simple.char Ez_file.V1.FileOS.path_separator) + +(* --- *) + +(** {2 Initialization} *) + +(** [straighten_if_tty oc fo ncols] adapts the margins of the formatter [fo], + whose underlying output channel {i must} be [oc], depending on the kind of + terminals they it is bound to. *) +let straighten_if_tty oc fo cols = + if Unix.isatty (Unix.descr_of_out_channel oc) then + pp_set_margin fo cols + +(** Initialization of standard formatters; calls {!Fmt_tty.setup_std_outputs}, + and, depending on the kind of terminals they are bound to, adapts the + margins of {!Fmt.stdout} and {!Fmt.stderr}. The width of the terminal + should be given in number of characters, using the environment variable + "COLUMNS"; otherwise a width of 180 characters is assumed. *) +let init_formatters ?style_renderer ?utf_8 () = + Fmt_tty.setup_std_outputs ?style_renderer ?utf_8 (); + let columns = + try Option.fold ~none:180 ~some:int_of_string (Sys.getenv_opt "COLUMNS") + with Invalid_argument _ -> 180 + in + let columns = if columns < 2 then 180 else columns in + straighten_if_tty Stdlib.stderr Fmt.stderr columns; + straighten_if_tty Stdlib.stdout Fmt.stdout columns diff --git a/src/lsp/pretty/pretty.mli b/src/lsp/pretty/pretty.mli new file mode 100644 index 000000000..058921794 --- /dev/null +++ b/src/lsp/pretty/pretty.mli @@ -0,0 +1,62 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* Documentation comments are in the corresponding ML file *) + +module Types: sig + type simple = (unit, Format.formatter, unit) format + type ('a, 'b) func = ('a, Format.formatter, unit, 'b) format4 -> 'a + type 'a proc = ('a, Format.formatter, unit) format -> 'a + type 'a printer = Format.formatter -> 'a -> unit + type 'a formatting = Format.formatter -> 'a + type delayed = unit formatting +end + +include module type of Types + +val print: Format.formatter -> 'a proc +val out: 'a proc +val error: 'a proc +val delayed: ('a, delayed) func +val delayed_to: (delayed -> 'b) -> ('a, 'b) func +val pp_set_margin: Format.formatter -> int -> unit +val blast_margin: Format.formatter -> unit +val to_string: ('a, string) func +val string_to: (string -> 'b) -> ('a, 'b) func +val failwith: ('a, 'b) func +val invalid_arg: ('a, 'b) func +val styles: Fmt.style list -> 'a printer -> 'a printer + +val char: char printer +val string: string printer +val text: string printer +val int64: int64 printer +val option: 'a printer -> 'a option printer +val list + : ?fopen:simple -> ?fsep:simple -> ?fclose:simple -> ?fempty:simple + -> 'a printer -> 'a list printer +val stack: 'a printer -> 'a list printer +val path: string list printer + +module Simple: sig + val int: int -> simple + val char: char -> simple + val string: string -> simple + val map + : (string -> string) + -> ('a, 'b, 'c, 'd, 'd, 'a) format6 + -> ('e, 'f, 'g, 'h, 'h, 'e) format6 +end + +val init_formatters + : ?style_renderer:Fmt.style_renderer -> ?utf_8:bool -> unit -> unit diff --git a/src/lsp/pretty/version.mlt b/src/lsp/pretty/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/lsp/pretty/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/lsp/superbol-free/README.md b/src/lsp/superbol-free/README.md new file mode 100644 index 000000000..0a44eebf6 --- /dev/null +++ b/src/lsp/superbol-free/README.md @@ -0,0 +1,3 @@ +# Superbol package + +This package contains the main driver for `superbol` diff --git a/src/lsp/superbol-free/dune b/src/lsp/superbol-free/dune new file mode 100644 index 000000000..1e0b7391a --- /dev/null +++ b/src/lsp/superbol-free/dune @@ -0,0 +1,35 @@ +; generated by drom from package skeleton 'driver' +(executable + (name main) + (public_name superbol-free) + (package superbol-free) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries superbol_free_lib ) + (flags ((:standard (:include linking.sexp)))) + ; use field 'dune-stanzas' to add more stanzas here + + + ) + +; Use `static-clibs` to specify static C libs (without lib prefix) +; and `static-macos-clibs` and `static-alpine-clibs` for system specific deps +(rule + (targets linking.sexp) + (enabled_if (<> %{ocaml-config:system} mingw64)) + (deps (file linking_flags.sh)) + (action (with-stdout-to %{targets} + (run bash linking_flags.sh linking.sexp %{env:LINKING_MODE=dynamic} %{ocaml-config:system} )))) + +(rule + (targets linking.sexp) + (enabled_if (= %{ocaml-config:system} mingw64)) + (deps (file linking_flags.sh)) + (action (with-stdout-to %{targets} + (run bash -c "echo '()' > linking.sexp")))) + + +(documentation + (package superbol-free)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/superbol-free/index.mld b/src/lsp/superbol-free/index.mld new file mode 100644 index 000000000..3787bfb33 --- /dev/null +++ b/src/lsp/superbol-free/index.mld @@ -0,0 +1,7 @@ +{1 Program superbol} + +Superbol is a set of utilities for COBOL developers, +that can be selected by sub-commands. + +This package is the main driver of [superbol]. + diff --git a/src/lsp/superbol-free/linking_flags.sh b/src/lsp/superbol-free/linking_flags.sh new file mode 100644 index 000000000..eb4a9c586 --- /dev/null +++ b/src/lsp/superbol-free/linking_flags.sh @@ -0,0 +1,79 @@ +#!/bin/sh + +set -ue + +# This script is called by dune to generate the linking flags for static builds +# (on the limited set of supported platforms). It only returns an empty set of +# flags for the default dynamic linking mode. + +LC_ALL=C + +help_exit() { + echo "Usage: $0 descriptiveID dynamic|static linux|macosx [extra-libs]" >&2 + exit 2 +} + +echo2() { + echo "$*" >&2 + echo "$*" +} + +[ $# -lt 3 ] && help_exit + +descID="$1" +shift + +echo2 ";; $descID" +echo2 ";; generated by $0" + +case "$1" in + dynamic) echo2 "()"; exit 0;; + static) ;; + *) echo "Invalid linking mode '$1'." >&2; help_exit +esac + +shift + +## Static linking configuration ## + +# The linked C libraries list may need updating on changes to the dependencies. +# +# To get the correct list for manual linking, the simplest way is to set the +# flags to `-verbose`, while on the normal `autolink` mode, then extract them +# from the gcc command-line. +# The Makefile contains a target to automate this: `make detect-libs`. + +case "$1" in + linux) + case $(. /etc/os-release && echo $ID) in + alpine) + COMMON_LIBS=" camlstr unix c" + # `m` and `pthread` are built-in musl + echo2 '(-noautolink' + echo2 ' -cclib -Wl,-Bstatic' + echo2 ' -cclib -static-libgcc' + for l in $COMMON_LIBS; do + echo2 " -cclib -l$l" + done + echo2 ' -cclib -static)' + ;; + *) + echo2 "Error: static linking is only supported in Alpine, to avoids glibc constraints (use scripts/static-build.sh to build through an Alpine Docker container)" >&2 + exit 3 + esac + ;; + macosx) + COMMON_LIBS="camlstr unix" + # `m` and `pthread` are built-in in libSystem + echo2 '(-noautolink' + for l in $COMMON_LIBS; do + if [ "${l%.a}" != "${l}" ]; then echo2 " -cclib $l" + else echo2 " -cclib -l$l" + fi + done + echo2 ')' + ;; + *) + echo "Static linking is not supported for your platform. See $0 to contribute." >&2 + exit 3 +esac diff --git a/src/lsp/superbol-free/linking_flags.sh.drom-tpl b/src/lsp/superbol-free/linking_flags.sh.drom-tpl new file mode 100644 index 000000000..f7d60d8d2 --- /dev/null +++ b/src/lsp/superbol-free/linking_flags.sh.drom-tpl @@ -0,0 +1,79 @@ +#!/bin/sh + +set -ue + +# This script is called by dune to generate the linking flags for static builds +# (on the limited set of supported platforms). It only returns an empty set of +# flags for the default dynamic linking mode. + +LC_ALL=C + +help_exit() { + echo "Usage: $0 descriptiveID dynamic|static linux|macosx [extra-libs]" >&2 + exit 2 +} + +echo2() { + echo "$*" >&2 + echo "$*" +} + +[ $# -lt 3 ] && help_exit + +descID="$1" +shift + +echo2 ";; $descID" +echo2 ";; generated by $0" + +case "$1" in + dynamic) echo2 "()"; exit 0;; + static) ;; + *) echo "Invalid linking mode '$1'." >&2; help_exit +esac + +shift + +## Static linking configuration ## + +# The linked C libraries list may need updating on changes to the dependencies. +# +# To get the correct list for manual linking, the simplest way is to set the +# flags to `-verbose`, while on the normal `autolink` mode, then extract them +# from the gcc command-line. +# The Makefile contains a target to automate this: `make detect-libs`. + +case "$1" in + linux) + case $(. /etc/os-release && echo $ID) in + alpine) + COMMON_LIBS="!(static-alpine-clibs) camlstr unix c" + # `m` and `pthread` are built-in musl + echo2 '(-noautolink' + echo2 ' -cclib -Wl,-Bstatic' + echo2 ' -cclib -static-libgcc' + for l in $COMMON_LIBS; do + echo2 " -cclib -l$l" + done + echo2 ' -cclib -static)' + ;; + *) + echo2 "Error: static linking is only supported in Alpine, to avoids glibc constraints (use scripts/static-build.sh to build through an Alpine Docker container)" >&2 + exit 3 + esac + ;; + macosx) + COMMON_LIBS="!(static-macos-clibs) unix" + # `m` and `pthread` are built-in in libSystem + echo2 '(-noautolink' + for l in $COMMON_LIBS; do + if [ "${l%.a}" != "${l}" ]; then echo2 " -cclib $l" + else echo2 " -cclib -l$l" + fi + done + echo2 ')' + ;; + *) + echo "Static linking is not supported for your platform. See $0 to contribute." >&2 + exit 3 +esac diff --git a/src/lsp/superbol-free/main.ml b/src/lsp/superbol-free/main.ml new file mode 100644 index 000000000..8126072a7 --- /dev/null +++ b/src/lsp/superbol-free/main.ml @@ -0,0 +1,14 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let () = Superbol_free_lib.Main.main () diff --git a/src/lsp/superbol-free/package.toml b/src/lsp/superbol-free/package.toml new file mode 100644 index 000000000..953ae461b --- /dev/null +++ b/src/lsp/superbol-free/package.toml @@ -0,0 +1,77 @@ + +# name of package +name = "superbol-free" +skeleton = "driver" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "program" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +# gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +# preprocess = "pps ppx_deriving_encoding" + +# files to skip while updating at package level +skip = ["index.mld"] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +superbol_free_lib = "version" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +dune-flags = "(:standard (:include linking.sexp))" +# static-alpine-clibs = "zarith gmp" +# static-macos-clibs = "zarith ${MACPORTS:-/usr/local/osxcross/macports/pkgs/opt/local}/lib/libgmp.a camlstr" +static-macos-clibs = "camlstr" diff --git a/src/lsp/superbol_free_lib/command_indent_file.ml b/src/lsp/superbol_free_lib/command_indent_file.ml new file mode 100644 index 000000000..0911b1346 --- /dev/null +++ b/src/lsp/superbol_free_lib/command_indent_file.ml @@ -0,0 +1,56 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ezcmd.V2 +open EZCMD.TYPES +open Cobol_indent + +open Common_args + +let action { source_format; _ } ~indent_config files = + List.to_seq files + |> Seq.map (fun file -> + indent_file ~source_format ~file ~indent_config) + +let cmd = + let files = ref [] in + let common, common_args = Common_args.get () in + let indent_config, indent_config_arg = + let indent_config = ref "./src/cobol_indent/user_def" in + let indent_config_arg = + ["indent_config"], + Arg.Set_string indent_config, + EZCMD.info ~docv:"FILE" "User defined configuration of indentation" + in + indent_config, indent_config_arg + in + let args = + common_args @ [indent_config_arg] + in + EZCMD.sub + "indent file" + (fun () -> + let common = common () in + Seq.iter ignore @@ action common !files + ~indent_config:(Some !indent_config)) + ~args:(args @ [ + [], + Arg.Anons (fun list -> files := list), + EZCMD.info ~docv:"FILES" "Cobol files to indent"]) + ~doc: "Indentation" + ~man:[ + `S "DESCRIPTION"; + `Blocks [ + `P "" + ]; + ] diff --git a/src/lsp/superbol_free_lib/command_indent_range.ml b/src/lsp/superbol_free_lib/command_indent_range.ml new file mode 100644 index 000000000..fd0b36fc5 --- /dev/null +++ b/src/lsp/superbol_free_lib/command_indent_range.ml @@ -0,0 +1,66 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ezcmd.V2 +open EZCMD.TYPES +open Cobol_indent + +open Common_args + +let action { source_format; _ } ~file ~range ~indent_config = + indent_range ~source_format ~file ~range ~indent_config + +let cmd = + let file = ref "" in + let start_line = ref "" in + let end_line = ref "" in + let direct_args = [ + [], Arg.Anon (0, fun f -> file := f), EZCMD.info ~docv:"FILE" "file to check the indentation"; + [], Arg.Anon (1, fun f -> start_line := f), EZCMD.info ~docv:"RANGE_START" "start line of range"; + [], Arg.Anon (2, fun f -> end_line := f), EZCMD.info ~docv:"RANGE_END" "end line of range"; + ] in + let common, common_args = Common_args.get () in + let indent_config, indent_config_arg = + let indent_config = ref "./src/cobol_indent/user_def" in + let indent_config_arg = + ["indent_config"], + Arg.Set_string indent_config, + EZCMD.info ~docv:"FILE" "User defined offset table file" + in + indent_config, indent_config_arg + in + let args = direct_args @ common_args @ [indent_config_arg] in + let range start_line end_line = + let open Cobol_indent.Type in + let start_line = !start_line |> Int32.of_string |> Int32.to_int in + let end_line = !end_line |> Int32.of_string |> Int32.to_int in + Some {start_line; end_line} + in + EZCMD.sub + "indent range" + (fun () -> + let common = common () in + action + common + ~indent_config:(Some !indent_config) + ~file:!file + ~range:(range start_line end_line) + ) + ~args + ~doc: "Indentation range" + ~man:[ + `S "DESCRIPTION"; + `Blocks [ + `P "" + ]; + ] diff --git a/src/lsp/superbol_free_lib/command_lsp.ml b/src/lsp/superbol_free_lib/command_lsp.ml new file mode 100644 index 000000000..1b6f73e79 --- /dev/null +++ b/src/lsp/superbol_free_lib/command_lsp.ml @@ -0,0 +1,35 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ezcmd.V2 + +let project_config_filename = "superbol.toml" +let relative_work_dirname = "_superbol" +let lsp_config = + Cobol_lsp.config ~project_config_filename ~relative_work_dirname + +let run_lsp () = + match Cobol_lsp.run ~config:lsp_config with + | Ok () -> () + | Error exit_msg -> Pretty.error "%s@." exit_msg; exit 1 + +let cmd = + EZCMD.sub "lsp" + run_lsp + ~doc:"run LSP server" + ~man:[ + `S "DESCRIPTION"; + `Blocks [ + `P "Start a COBOL LSP server" + ]; + ] diff --git a/src/lsp/superbol_free_lib/command_pp.ml b/src/lsp/superbol_free_lib/command_pp.ml new file mode 100644 index 000000000..a97d9ba73 --- /dev/null +++ b/src/lsp/superbol_free_lib/command_pp.ml @@ -0,0 +1,82 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ezcmd.V2 +open EZCMD.TYPES + +open Common_args + +let cmd = + let files = ref [] in + let cobc = ref false in + let output = ref None in + let common_get, common_args = Common_args.get () in + EZCMD.sub + "pp" + (fun () -> + match List.rev !files with + | [] -> + failwith "Provide at list one file" + | files -> + List.iter (fun file -> + let filename = match !output with + | None -> ( Filename.chop_extension file ) ^ ".i" + | Some output -> + begin match files with + | [ _ ] -> () + | _ -> + failwith "Option -o conflicts with providing multiple files" + end; + output + in + if filename = file then + Pretty.failwith "Source file conflicts with target %s" file; + let text = + let common = common_get () in + Cobol_preproc.text_of_file file + ~verbose: common.verbose + ~source_format:common.source_format + ~libpath:common.libpath + in + let s = + Cobol_preproc.Text_printer.string_of_text + ~cobc:!cobc + ~max_line_gap:100 + text in + match filename with + | "-" -> + Printf.printf "%s\n%!" s + | _ -> + let oc = open_out filename in + output_string oc s; + close_out oc; + Printf.eprintf "File %S generated\n%!" filename;) + files) + ~args: (common_args @ [ + [ "cobc" ], Arg.Set cobc, + EZCMD.info "Activate cobc specific features"; + + [ "output"; "o" ], Arg.String (fun f -> output := Some f), + EZCMD.info ~docv:"FILE" "Output File (use '-' for stdout)"; + + [], Arg.Anon (0, fun f -> files := f :: !files), + EZCMD.info ~docv:"FILE" "Cobol file to preprocess"; + ]) + ~doc: "Preprocess a list of COBOL files, generating a preprocessed \ + file with extension .i for each of them" + ~man:[ + `S "DESCRIPTION"; + `Blocks [ + `P "" + ]; + ] diff --git a/src/lsp/superbol_free_lib/command_texi2rst.ml b/src/lsp/superbol_free_lib/command_texi2rst.ml new file mode 100644 index 000000000..64f63d68f --- /dev/null +++ b/src/lsp/superbol_free_lib/command_texi2rst.ml @@ -0,0 +1,1474 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open EzCompat +open Ezcmd.V2 +open EZCMD.TYPES +open Ez_file.V1 +open EzFile.OP +open Cobol_common.Diagnostics (* For Fatal.error *) + +module LOCATION = struct + type t = { filename : string ; line : int } + let to_string t = Printf.sprintf "%s:%d" t.filename t.line + let any = { filename = ""; line = 0 } +end + +module INPUT = struct + + type t = { + ic : in_channel ; + filename : string ; + mutable line : int ; + } + + let open_in filename = + let ic = open_in filename in + { + ic ; + filename ; + line = 0; + } + + let input_line ic = + let line = input_line ic.ic in + ic.line <- ic.line + 1; + line + + let close_in ic = close_in ic.ic + + let error ?ic fmt = + Printf.kprintf (fun s -> + begin + match ic with + | Some ic -> + Printf.eprintf "Error at %s:%d: %s\n%!" + ic.filename ic.line s; + | None -> + Printf.eprintf "Error at end of input: %s\n%!" s + end; + exit 2 + ) fmt + + let warning ic fmt = + Printf.kprintf (fun s -> + Printf.eprintf "Warning at %s:%d: %s\n%!" + ic.filename ic.line s; + ) fmt + + let loc ic = + { LOCATION.filename = ic.filename ; LOCATION.line = ic.line } + +end + +module OUTPUT = struct + + type t = { + filename : string ; + buffer : Buffer.t ; + } + + let open_out filename = + let buffer = Buffer.create 10_000 in + { filename ; buffer } + + let fprintf t fmt = Printf.bprintf t.buffer fmt + + let close_out t = + EzFile.write_file t.filename (Buffer.contents t.buffer) +end + +type line = inline list + +and inline = + | S of string + | M of LOCATION.t * string * line + | Q of line + + +type blocks = block list + +and block = + EMPTY_LINE + | LINE of line + | BLOCK of string * blocks + | LEVEL of int * string option * line * blocks + | ITEMS of string * string * ( line * blocks ) list + | INDEX of string + | DIAGRAM of string * blocks + +type document = { + basename : string ; + title : line option ; + subtitle : line option ; + authors : line list ; + content : blocks ; +} + +let rec string_of_line line = + String.concat "" + (List.map (function + | S s -> s + | Q arg -> + Printf.sprintf "@QUOTE[%s]" ( string_of_line arg ) + | M (_loc, macro, arg) -> + Printf.sprintf "@@%s{{%s}}" macro + ( string_of_line arg )) line) + +let split_command line = + let len = String.length line in + if len = 0 then + line, line + else + let rec iter line i len = + if i = len then + line, "" + else + match line.[i] with + | ' ' -> + String.sub line 0 i, + String.sub line (i+1) (len-i-1) + | '@' + | '{' -> + String.sub line 0 i, + String.sub line i (len-i) + | _ -> + iter line (i+1) len + in + iter line 1 len + +type block_kind = + RawBlock + | Level of int * string option * line + | Items of string * + ( line option ) * + (line * blocks) list + +type closer = + | EOL + | BRACE + | QUOTE + +let read filename = + + let file = Filename.basename filename in + let dirname = Filename.dirname filename in + + let title = ref None in + let subtitle = ref None in + let authors = ref [] in + let map = ref StringMap.empty in + + let maybe b = + let s = Buffer.contents b in + Buffer.clear b; + if s = "" then [] else [ S s ] + in + let parse_line ic line = + let len = String.length line in + let b = Buffer.create len in + let rec iter i braced = + if i = len then + if braced <> EOL then + INPUT.error ~ic "unexpected end of line" + else + len, + maybe b + else + match line.[i] with + | '}' -> + if braced <> BRACE then + INPUT.error ~ic "unbalanced closing brace" ; + i+1, maybe b + | '@' -> + let i = i+1 in + if i = len then + if braced <> EOL then + INPUT.error ~ic "unexpected end of line" + else + len, maybe b + else + begin + let c = line.[i] in + match c with + | '{' | '}' | '@' | '.' | '!' | '?' -> + Buffer.add_char b c ; + iter (i+1) braced + | '\n' -> + iter (i+1) braced + | '*' -> + let before = maybe b in + let i, line = iter (i+1) braced in + i, before @ M (INPUT.loc ic, "linebreak", []) :: line + | _ -> + let before = maybe b in + let i, line = iter_macro i i braced in + i, before @ line + end + | '`' when i+1 < len && line.[i+1] = '`' -> + let before = maybe b in + let i = i+2 in + let i, quoted = iter i QUOTE in + let i, line = iter i braced in + i, before @ Q quoted :: line + | '\'' when i+1 < len && line.[i+1] = '\'' -> + if braced <> QUOTE then + INPUT.error ~ic "unbalanced ending quote"; + let before = maybe b in + let i = i+2 in + i, before + | c -> + Buffer.add_char b c ; + iter (i+1) braced + + and iter_macro i pos0 braced = + if i = len then + if braced <> EOL then + INPUT.error ~ic "unexpected end of line" + else + let macro = String.sub line pos0 (i-pos0) in + len, [ M (INPUT.loc ic, macro, []) ] + else + match line.[i] with + | '{' -> + let macro = String.sub line pos0 (i-pos0) in + let i, arg = iter (i+1) BRACE in + let i, line = iter i braced in + i, begin + match macro with + | "value" -> + let arg = string_of_line arg in + begin + match StringMap.find arg !map with + | s -> S s :: line + | exception Not_found -> + INPUT.error ~ic "Unknown variable %S" arg + end + | _ -> M (INPUT.loc ic, macro, arg) :: line + end + + | ' ' | '\t' -> + let macro = String.sub line pos0 (i-pos0) in + let i, line = iter (i+1) braced in + i, M (INPUT.loc ic, macro, []) :: line + | _ -> iter_macro (i+1) pos0 braced + + in + let i, line = iter 0 EOL in + if i '{' || arg.[len-1] <> '}' then + None, parse_line ic arg + else + let arg = String.sub arg 1 (len-2) in + let number, title = EzString.cut_at arg ',' in + if number = "" || title = "" then + INPUT.error ~ic "Wrong argument %S for section" arg; + let title = parse_line ic title in + Some number, title + in + + let rec iter_file file rev stack = + let filename = Filename.concat dirname file in + Printf.eprintf "Reading %S\n%!" filename; + let ic = INPUT.open_in filename in + iter_lines ic rev stack + + and iter_lines ic rev stack = + match INPUT.input_line ic with + | exception _ -> + INPUT.close_in ic; + rev, stack + | line -> + let command, arg = split_command line in + match command with + + (* Discard these lines *) + | "@paragraphindent" + | "@sp" + | "@c" + | "@top" + | "@settitle" + | "\\input" + | "@page" + | "@unnumbered" + | "@printindex" + | "@bye" + | "@headings" + | "@oddheading" + | "@oddfooting" + | "@evenheading" + | "@evenfooting" + | "@validatemenus" + | "@node" + | "@contents" + | "@comment" + | "@comment*" + | "@setfilename" + | "@finalout" + | "@setchapternewpage" + | "@dircategory" + | "@*Document" + | "@*Updates:" + | "@vskip" + | "@insertcopying" + -> + iter_lines ic rev stack + + | "@cindex" -> + iter_lines ic (INDEX arg :: rev) stack + | "@set" -> + let name, value = EzString.cut_at arg ' ' in + map := StringMap.add name value !map; + iter_lines ic rev stack + | "@title" -> + title := Some ( parse_line ic arg ) ; + iter_lines ic rev stack + | "@subtitle" -> + subtitle := Some ( parse_line ic arg ) ; + iter_lines ic rev stack ; + | "@author" -> + authors := ( parse_line ic arg ) :: !authors ; + iter_lines ic rev stack + | "@include" -> + let rev, stack = + if arg = "Macros.texi" then rev, stack else + iter_file arg rev stack in + iter_lines ic rev stack + + | "@end" -> + iter_end ic rev stack arg + | "@enddict" -> + iter_end ic rev stack "table" + + | "@float" + | "@format" + | "@smallformat" + | "@cartouche" + | "@ifhtml" + | "@html" + | "@display" + | "@group" + | "@raggedright" + | "@example" + | "@smallexample" + | "@ifinfo" + | "@iftex" + | "@ifnottex" + | "@titlepage" + | "@quotation" + | "@direntry" + | "@copying" + | "@detailmenu" + | "@menu" + -> + let name = String.sub command 1 ( String.length command - 1 ) in + iter_lines ic [] ( ( name, RawBlock, rev ) :: stack ) + + | "@verbatim" + | "@tex" + -> + let name = String.sub command 1 ( String.length command - 1 ) in + let rec verbatim ic rev = + match INPUT.input_line ic with + | exception _ -> + INPUT.close_in ic; + INPUT.error ~ic "unclosed verbatim block" + | "@end verbatim" + | "@end tex" + -> List.rev rev + | line -> + verbatim ic ( LINE [S line] :: rev ) + in + (* TODO: because we don't interprete these lines, there are @w{} inside. *) + let verbatim = verbatim ic [] in + iter_lines ic ( BLOCK (name, verbatim) :: rev ) stack + + | "@multitable" + | "@table" + | "@itemize" + | "@enumerate" + -> + let name = String.sub command 1 ( String.length command - 1 ) in + iter_lines ic [] ( ( name, Items (arg, None, []), rev ) :: stack ) + + | "@headitem" (* TODO: for multitable *) + | "@item" + | "@itemx" (* TODO Must improve *) + (* TODO: ~~~~~~~~~~ in diagrams are removed by rst *) + -> + let arg = parse_line ic arg in + let stack = end_item ic rev stack (Some arg) in + iter_lines ic [] stack + + | "@newchapter" -> + iter_section ic rev stack 1 arg + | "@newappendix" -> + iter_section ic rev stack 1 arg + | "@section" -> + iter_section ic rev stack 2 arg + | "@newsection" -> + iter_section ic rev stack 2 arg + | "@newsubsection" -> + iter_section ic rev stack 3 arg + | "@newunit" -> + iter_section ic rev stack 4 arg + + | "@diagram" -> + let len = String.length arg in + if len < 3 || + arg.[0] <> '{' || arg.[len-1] <> '}' then + INPUT.error ~ic "invalid argument for @diagram"; + let arg = String.sub arg 1 (len-2) in + begin + match List.map String.trim @@ EzString.split arg ',' with + | [ title ; id1 ; id2 ; note ] -> + + if id1 <> id2 then + INPUT.warning ic "diagram with %s <> %s\n%!" + id1 id2; + + let lines = EzFile.read_lines_to_list + ( dirname // + Printf.sprintf "SYN-%s.texi" id1) in + let block = + DIAGRAM (title, List.map (fun s -> LINE [ S s]) lines) + in + let note = + if note = "None" then [] + else + + let rev, _stack = + iter_file (Printf.sprintf "NOTE-%s.texi" note) [] [] + in + rev + in + iter_lines ic ( note @ block :: rev ) stack + | _ -> + INPUT.error ~ic "invalid arguments for @diagram"; + end + + | _ -> + if line = "" then + iter_lines ic ( EMPTY_LINE :: rev ) stack + else + let line = parse_line ic line in + iter_lines ic ( LINE line :: rev ) stack + + and end_item ic rev stack item_arg = + match stack with + | [] -> + INPUT.error ~ic "@end/@item with empty stack" + | (name, Items (header, item_arg_before, items), rev_before) + :: stack_before -> + let middle = + match item_arg_before, rev with + | None, rev -> + if not ( List.for_all (fun line -> + match line with + | EMPTY_LINE -> true + | _ -> false) rev) then + let items = + ( [], List.rev rev ) :: items + in + Items (header, item_arg, items) + else + Items (header, item_arg, items) + | Some item_arg_before, _ -> + let items = + ( item_arg_before, List.rev rev ) :: items + in + Items (header, item_arg, items) + in + (name, middle, rev_before) :: stack_before + | (name, _, _) :: _ -> + INPUT.error ~ic "@item in %S block" name + + and iter_section ic rev stack level arg = + let rev, stack = end_section ~ic rev stack level in + let number, title = parse_level ic arg in + iter_lines ic [] ( ("section", Level (level, number, title), rev ) :: stack ) + + and end_section ?ic rev stack level = + match stack with + | [] -> + if level > 1 then + INPUT.error ?ic "[sub]section at topelevel"; + rev, stack + | ("section", Level (level_before, number, title), rev_before ) :: + stack_before -> + if level_before >= level then + let item = LEVEL (level_before, number, title, List.rev rev) in + let rev = item :: rev_before in + end_section rev stack_before level + else + rev, stack + | (name, _, _) :: _ -> + INPUT.error ?ic "missing @end %s\n%!" name + + and iter_end ic rev stack arg = + let rev, stack = + match arg with + | "table" + | "multitable" + | "enumerate" + | "itemize" -> + [], end_item ic rev stack None + | _ -> rev, stack + in + begin + match stack with + | [] -> + INPUT.error ~ic "@end %s with empty stack" arg + | ( name, content, rev_before ) :: stack_before -> + if name <> arg then + INPUT.error ~ic "@end %s but %S expected\n%!" + arg name ; + let rev = match name with + + | "iftex" + | "ifhtml" + | "titlepage" + | "direntry" + | "menu" + -> rev_before + + | "multitable" + | "table" + | "enumerate" + | "itemize" + -> + begin + match content with + | Items (header, None, items) -> + ITEMS ( name, header, List.rev items) :: rev_before + | _ -> assert false + end + + | _ -> BLOCK ( name, List.rev rev ) :: rev_before + in + iter_lines ic rev stack_before + + end + + in + let rev, stack = iter_file file [] [] in + + let rev, _stack = end_section rev stack 0 in + + { + basename = Filename.chop_suffix file ".texi"; + content = List.rev rev ; + title = !title ; + subtitle = !subtitle ; + authors = List.rev !authors ; + } + +let spaces = String.make 1000 ' ' +let spaces indent = String.sub spaces 0 indent + +let print_blocks oc doc = + + let rec iter indent doc = + match doc with + | [] -> () + | item :: doc -> + begin + match item with + | EMPTY_LINE -> Printf.fprintf oc "%sEMPTY_LINE\n" (spaces indent) + | INDEX index -> + Printf.fprintf oc "%sINDEX %s\n" (spaces indent) index + | LINE line -> + Printf.fprintf oc "%sLINE[%s]\n" + ( spaces indent ) ( string_of_line line ) + | BLOCK (name, doc) -> + Printf.fprintf oc "%sBEGIN %s <<<<<\n" ( spaces indent ) name ; + iter ( indent + 2 ) doc; + Printf.fprintf oc "%sEND %s >>>>>\n" ( spaces indent ) name; + | DIAGRAM (name, doc) -> + Printf.fprintf oc "%sDIAGRAM %s <<<<<\n" ( spaces indent ) name ; + iter ( indent + 2 ) doc; + Printf.fprintf oc "%sEND %s >>>>>\n" ( spaces indent ) name; + | LEVEL (level, number, title, doc) -> + Printf.fprintf oc "%sLEVEL %d %s -> %s <<<<<\n" + ( spaces indent ) level + ( match number with + | None -> "DIRECT" + | Some number -> number) (string_of_line title ) ; + iter ( indent + 2 ) doc; + Printf.fprintf oc "%sEND LEVEL %d >>>>>\n" ( spaces indent ) level + | ITEMS (name, header, items) -> + Printf.fprintf oc "%sITEMS %s %s <<<<<\n" + ( spaces indent ) name header; + List.iter (fun (title, item) -> + Printf.fprintf oc "%s ITEM %s\n" ( spaces indent ) + ( string_of_line title ); + iter (indent + 4) item + ) items ; + Printf.fprintf oc "%sEND ITEMS %s >>>>>\n" ( spaces indent ) name + end; + iter indent doc + + in + iter 0 doc + +let print_doc ?dir doc = + let oc = match dir with + | None -> stdout + | Some dir -> open_out ( dir // doc.basename ^ ".format" ) + in + begin + match doc.title with + | None -> () + | Some title -> Printf.fprintf oc "TITLE: %S\n%!" ( string_of_line title ) + end; + begin match doc.subtitle with + | None -> () + | Some title -> Printf.fprintf oc "SUBTITLE: %S\n%!" + ( string_of_line title ) + end; + List.iter (fun author -> + Printf.fprintf oc "AUTHOR: %S\n%!" + ( string_of_line author ) ) doc.authors; + print_blocks oc doc.content ; + Printf.fprintf oc "@!"; + match dir with + | None -> () + | Some _ -> close_out oc + +let label_of_title s = + String.map (fun c -> + match c with + | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' -> c + | _ -> 'A') s + +type verbatim = + | Block + | LiteralBlock + | ParsedLiteral + +type ctx = { + doc : document ; + mutable math : bool list; + mutable verbatim : verbatim list ; + + mutable line : int ; + line_indexes : (int, string) Hashtbl.t; + new_line_indexes : (int, string) Hashtbl.t; + line_anchors : (int, string) Hashtbl.t; + new_line_anchors : (int, string) Hashtbl.t; + + refs_external : ( string * string ) StringMap.t ; + refs_allowed : StringSet.t option ; + mutable files : string list ; + mutable footnotes : string list ; + mutable unknown_macros : LOCATION.t StringMap.t ; + mutable refs_created : StringSet.t ; + mutable anchors_created : StringSet.t ; + mutable index_created : StringSet.t ; + mutable refs_used : LOCATION.t StringMap.t ; +} + +let add_index ctx label = + ctx.refs_created <- StringSet.add label ctx.refs_created ; + Hashtbl.add ctx.new_line_indexes ctx.line label + +let add_anchor ctx label = + let label = label_of_title label in + ctx.refs_created <- StringSet.add label ctx.refs_created ; + ctx.anchors_created <- StringSet.add label ctx.anchors_created ; + Hashtbl.add ctx.new_line_anchors ctx.line label + +let place_for_indexes ctx oc indent = + ctx.line <- ctx.line + 1; + + let indexes = Hashtbl.find_all ctx.line_indexes ctx.line in + if indexes <> [] then begin + OUTPUT.fprintf oc "\n"; + List.iter (fun label -> + OUTPUT.fprintf oc "%s.. index:: single:%s\n" indent label; + ) indexes; + OUTPUT.fprintf oc "\n"; + end; + let anchors = Hashtbl.find_all ctx.line_anchors ctx.line in + if anchors <> [] then begin + OUTPUT.fprintf oc "\n"; + List.iter (fun label -> + OUTPUT.fprintf oc "\n%s.. _%s:\n" indent label; + ) anchors; + OUTPUT.fprintf oc "\n"; + end; + () + +let rst_escape s = + let len = String.length s in + + let rec escape b s i len = + if i = len then + Buffer.contents b + else + let c = s.[i] in + begin + match c with + | '*' | '`' -> Buffer.add_char b '\\'; Buffer.add_char b c + | _ -> Buffer.add_char b c + end; + escape b s (i+1) len + in + let rec iter s i len = + if i = len then + s + else + match s.[i] with + | '*' | '`' -> + let b = Buffer.create (len+10) in + escape b s 0 len + | _ -> iter s (i+1) len + in + iter s 0 len + +let rst_trim s = + let len = String.length s in + let rec iter s i len = + if i0 && s.[i-1] = ' ' && (i=1 || s.[i-2] <> '\\') then + iter s (i-1) len + else + i + in + let end_s = iter s len len in + if begin_s = 0 && end_s = len then s else + String.sub s begin_s (end_s - begin_s) + +let rec rst_of_line ctx line = + String.concat "" @@ + List.map (function + | S s -> + begin + match ctx.math, ctx.verbatim with + | true :: _, _ + | _, LiteralBlock :: _ -> s + | _ -> + rst_escape s + end + | Q q -> Printf.sprintf "\"%s\"" ( rst_of_line ctx q ) + + | M ( loc, name, arg) -> + match name with + + | "_" -> rst_of_line ctx arg + + (****** texinfo generic macros *) + + | "TeX" -> "TeX" + | "w" -> "" + | "noindent" -> "" + | "anchor" -> + let arg = rst_of_line0 ctx arg in + add_anchor ctx arg; + "" + | "i" + -> + let arg = rst_of_line0 ctx arg in + Printf.sprintf "\\ *%s*\\ " arg + | "dfn" + -> + let arg = rst_of_line0 ctx arg in + Printf.sprintf "\\ *%s*\\ " arg + | "kbd" + | "option" + | "env" -> rst_of_line ctx [ M (loc, "code", arg)] + | "sc" -> rst_of_line ctx [ M (loc, "small-caps", arg)] + | "code" -> + let arg = + let verbatim_stack = ctx.verbatim in + ctx.verbatim <- LiteralBlock :: ctx.verbatim; + let arg = rst_of_line ctx arg in + ctx.verbatim <- verbatim_stack ; + arg + in + if List.hd ctx.verbatim = LiteralBlock then + arg + else + let arg = rst_trim arg in + Printf.sprintf "\\ :%s:`%s`\\ " name arg + | "small-caps" + | "command" + | "file" + -> + let arg = rst_of_line ctx arg in + if List.hd ctx.verbatim = LiteralBlock then + arg + else + Printf.sprintf " :%s:`%s`" name arg + | "math" -> + let math_stack = ctx.math in + ctx.math <- true :: math_stack ; + let arg = rst_of_line ctx arg in + ctx.math <- math_stack ; + Printf.sprintf " :math:`%s`" arg + | "email" -> rst_of_line ctx arg + | "uref" + | "url" + -> + let arg = rst_of_line ctx arg in + let url, name = EzString.cut_at arg ',' in + if name <> "" then + Printf.sprintf " `%s <%s>`_" (rst_trim name) url + else + Printf.sprintf " `<%s>`_" url + | "var" -> + let arg = rst_of_line0 ctx arg in + Printf.sprintf "<%s>" arg + | "strong" + | "b" + -> + let arg = rst_of_line0 ctx arg in + Printf.sprintf "\\ **%s**\\ " arg + | "ref" -> + let arg = rst_of_line0 ctx arg in + add_ref ctx loc arg + | "pxref" + | "xref" + -> + let arg = parse_args ctx arg in + begin + match arg with + | arg :: _ -> + add_ref ctx loc arg + | [] -> assert false + end + | "acronym" -> + let arg = rst_of_line0 ctx arg in + Printf.sprintf ":abbr:`%s`" arg + | "linebreak" -> assert false + | "dots" -> "..." + | "center" -> "\n " (* TODO improve *) + | "footnote" -> + let arg = rst_of_line ctx arg in + ctx.footnotes <- arg :: ctx.footnotes; + " [#]_ " + | "leq" -> " :math:`\\leq`" + | "r" -> + let arg = rst_of_line ctx arg in + if List.hd ctx.verbatim = LiteralBlock then + arg + else + arg + | "" -> + assert (arg = []); + if List.hd ctx.math then "~" else " |_| " + | "tab" | "result" -> + assert (arg = []); + " " + + (* gnucobol specific macros from Macros.texi *) + + + | "anchoridx" -> + rst_of_line ctx [ M (loc, "idx", arg); + M (loc, "anchor", arg) ] + | "define" + | "itemdfn" + -> + rst_of_line ctx [ M (loc, "idx", arg ) ; + M (loc, "dfn", arg ) ] + | "directive" -> + rst_of_line ctx [ M (loc, "code", arg) ; S " CDF directive" ] + | "directiveref" -> + with_pxref ctx loc "directive" arg + | "envvarcompile" -> + with_pxref ctx loc "code" ~arg + ~prefix: [ + M (loc, "idx", arg @ [ S " Environment Variable"]) ; + M (loc, "idx", [ S " Environment Variables, "] @ arg) ; + ] + ~suffix:" compilation-time environment variable" + [ S "Compilation Time Environment Variables" ] + | "envvarruntime" -> + rst_of_line ctx [ + M (loc, "idx", arg @ [ S " Environment Variable"]) ; + M (loc, "idx", [ S " Environment Variables, "] @ arg) ; + S " run-time environment variable" ] + | "envvarruntimeref" -> + with_pxref ctx loc "envvarruntime" ~arg + [ S "Run Time Environment Variables" ] + | "envvarruntimerefs" -> + with_pxref ctx loc "envvarruntime" ~arg + ~suffix: " run-time environment variables" + [ S "Run Time Environment Variables" ] + | "idx" -> + let arg = rst_of_line0 ctx arg in + add_index ctx arg; + if List.hd ctx.verbatim = Block then "\\ " else "" + | "intrinsic" -> + rst_of_line ctx [ M (loc, "code", arg) ; S " intrinsic function" ] + | "intrinsicref" -> + with_pxref ctx loc "intrinsic" arg + (* newappendix *) + (* newappsec *) + (* newchapter *) + (* newsection *) + (* newsubsection *) + (* newunit *) + | "registertext" -> + rst_of_line ctx [ M (loc, "code", arg) ; S " special register" ] + | "register" -> + rst_of_line ctx [ M (loc, "idx", arg @ [ S " Special Register" ] ); + M (loc, "idx", [ S " Special Registers, " ] @ arg ); + M (loc, "registertext", arg); + ] + | "registerref" -> + with_pxref ctx loc "register" ~arg [ S "Special Registers" ] + | "registerrefalt" -> + with_pxrefalt ctx loc "register" arg + | "statement" -> + rst_of_line ctx [ M (loc, "code", arg) ; S " statement" ] + | "statementref" -> + with_pxref ctx loc "statement" arg + | "statementrefalt" -> + with_pxrefalt ctx loc "statement" arg + | "subpgm" -> + rst_of_line ctx [ M (loc, "code", arg) ; S " built-in system subroutine" ] + | "subpgmref" -> + with_pxref ctx loc "subpgm" arg + | "switch" -> + rst_of_line ctx [ M (loc, "option", arg) ; S " switch" ] + | "switchidx" -> + rst_of_line ctx [ M (loc, "idx", [ S "Compiler Switches, " ] @ arg) ; + M (loc, "idx", arg @ [ S " Compiler Switch" ]) ; + M (loc, "switch", arg) ] + | "syntaxidx" -> + rst_of_line ctx [ M (loc, "idx", arg); + M (loc, "code", arg); ] + | "plainidx" -> + rst_of_line ctx ( [ M (loc, "idx", arg) ] @ arg ) + | "syntaxref" -> + with_pxref ctx loc "code" arg + | "syntaxrefalt" -> + with_pxrefalt ctx loc "code" arg + | "termrefalt" -> + with_pxrefalt ctx loc "i" arg + | "topic" -> + with_pxref ctx loc "_" arg + + + | "t" -> rst_of_line ctx [ M (loc, "code", arg) ] + | "key" + -> + let arg = rst_of_line0 ctx arg in + Printf.sprintf "\\ :code:`%s`\\ " arg + | "samp" -> + let arg = rst_of_line0 ctx arg in + if List.hd ctx.verbatim = LiteralBlock then + Printf.sprintf "'%s'" arg + else + Printf.sprintf "'\\ :code:`%s`\\ '" arg + + | "sup" -> + let arg = rst_of_line ctx arg in + if List.hd ctx.math then + Printf.sprintf "^{%s}" arg + else + Printf.sprintf "\\ :sup:`%s`\\ " arg + + | "copyright" -> "\\ |copy|\\ " + | command -> + let arg = rst_of_line ctx arg in + if not ( StringMap.mem command ctx.unknown_macros ) then begin + Printf.eprintf "%s: unknown macro %S\n%!" + (LOCATION.to_string loc) command ; + ctx.unknown_macros <- StringMap.add command loc ctx.unknown_macros; + end ; + Printf.sprintf "@%s{{ %s }}" command arg + ) line + +and add_ref ctx loc arg = + let label = label_of_title arg in + match StringMap.find label ctx.refs_external with + | (anchor, ref) -> + Printf.sprintf " `%s <%s>`_" ref anchor + | exception Not_found -> + ctx.refs_used <- StringMap.add label loc ctx.refs_used; + if StringSet.mem label ctx.anchors_created then + Printf.sprintf " :ref:`%s <%s>`" arg label + else + Printf.sprintf " :ref:`%s`" label + +and parse_args ctx arg = + let arg = rst_of_line ctx arg in + List.map rst_trim (EzString.split arg ',') + +and rst_of_line0 ctx line = + let arg = rst_of_line ctx line in + if List.hd ctx.verbatim = LiteralBlock then + arg + else + rst_trim arg + +and with_pxref ctx loc name ?arg ?(prefix=[]) ?suffix ref = + let arg = match arg with + | None -> ref + | Some arg -> arg + in + let prefix = match suffix with + | None -> prefix @ [ M (loc, name, arg) ] + | Some suffix -> prefix @ [ M (loc, name, arg); S suffix ] + in + rst_of_line ctx (prefix @ [ S " ("; M (loc, "pxref", ref); S ")" ]) + +and with_pxrefalt ctx loc name arg = + match parse_args ctx arg with + | [ text ; ref ] -> + with_pxref ctx loc name ~arg:[ S text ] [ S ref ] + | _ -> assert false + +let rst_of_line = rst_of_line0 + +let output_level ctx oc level ?number title = + + let title = rst_of_line ctx title in + add_index ctx title ; + + OUTPUT.fprintf oc "\n"; + if match number with + | None -> false + | Some s -> + match s.[0] with + | '0'..'9' -> true + | _ -> false + then begin + let label = label_of_title title in + ctx.refs_created <- StringSet.add label ctx.refs_created; + OUTPUT.fprintf oc "\n.. _%s:\n" label; + end; + let title = match number with + | None -> title + | Some number -> Printf.sprintf "%s %s" number title + in + + let len = String.length title in + let c = match level with + | 1 -> '=' + | 2 -> '-' + | 3 -> '~' + | 4 -> '^' + | _ -> assert false + in + OUTPUT.fprintf oc "\n%s\n" title ; + OUTPUT.fprintf oc "%s\n" ( String.make len c) + +let linebreaks line = + if List.exists (function + M (_loc, "linebreak", []) -> true + | _ -> false ) line then + let rec iter lines rev line = + match line with + | [] -> + List.rev + ( match rev with + | [] -> lines + | _ -> List.rev rev :: lines ) + | M ( _loc, "linebreak", [] ) :: line -> + iter (List.rev rev :: lines ) [] line + | inline :: line -> + iter lines ( inline :: rev ) line + in + iter [] [] line + else + [ line ] + +let rec output_blocks ctx oc indent blocks = + match blocks with + | [] -> () + | [ EMPTY_LINE ] -> () + | block :: blocks -> + output_block ctx oc indent block; + output_blocks ctx oc indent blocks + +and output_block ctx oc indent block = + match block with + | LINE line -> + begin + match linebreaks line with + | [ line ] -> + let line = rst_of_line ctx line in + begin + match line with + "\\" | "\\ " -> () + | _ -> OUTPUT.fprintf oc "%s%s\n" indent line + end + | lines -> + List.iter (fun line -> + OUTPUT.fprintf oc "%s| %s\n" indent + ( rst_of_line ctx line ) + ) lines + end + | INDEX index -> + add_index ctx index + | EMPTY_LINE -> + OUTPUT.fprintf oc "%s\n" indent ; + place_for_indexes ctx oc indent ; + () + | LEVEL (level, number, title, blocks) -> + assert (indent = ""); + place_for_indexes ctx oc indent ; + output_level ctx oc level ?number title ; + place_for_indexes ctx oc indent ; + output_blocks ctx oc "" blocks ; + + | BLOCK ("quotation", blocks) -> + OUTPUT.fprintf oc "\n%s\n%s" indent indent; + output_blocks ctx oc (indent^" ") blocks; + OUTPUT.fprintf oc "%s\n" indent + + | BLOCK ("group", blocks) -> + output_blocks ctx oc indent blocks + + | DIAGRAM (title, blocks) -> + if ctx.doc.basename = "gnucobqr" then begin + place_for_indexes ctx oc "" ; + output_level ctx oc 2 [ S ( title ^ " Syntax") ] ; + end + else + OUTPUT.fprintf oc "%s%s Syntax\n" indent title; + + let verbatim_stack = ctx.verbatim in + ctx.verbatim <- LiteralBlock :: verbatim_stack ; + begin + match List.hd verbatim_stack with + | Block -> + OUTPUT.fprintf oc "%s::\n \n" indent; + output_blocks ctx oc (indent^" ") blocks; + OUTPUT.fprintf oc "%s\n" indent; + | ParsedLiteral | LiteralBlock -> + output_blocks ctx oc indent blocks + end; + ctx.verbatim <- verbatim_stack + + | BLOCK ("verbatim", blocks) + | BLOCK ("example", blocks) + | BLOCK ("smallexample", blocks) + | BLOCK ("format", blocks) + | BLOCK ("smallformat", blocks) + -> + let verbatim_stack = ctx.verbatim in + ctx.verbatim <- LiteralBlock :: verbatim_stack ; + begin + match List.hd verbatim_stack with + | Block -> + OUTPUT.fprintf oc "%s::\n \n" indent; + output_blocks ctx oc (indent^" ") blocks; + OUTPUT.fprintf oc "%s\n" indent; + | ParsedLiteral | LiteralBlock -> + output_blocks ctx oc indent blocks + end; + ctx.verbatim <- verbatim_stack + + | BLOCK ("display", blocks) + -> + let verbatim_stack = ctx.verbatim in + begin + match List.hd verbatim_stack with + | ParsedLiteral | LiteralBlock -> + output_blocks ctx oc indent blocks + | Block -> + ctx.verbatim <- LiteralBlock :: verbatim_stack ; + OUTPUT.fprintf oc "%s\n%s.. parsed-literal::\n \n" indent indent; + output_blocks ctx oc (indent^" ") blocks; + OUTPUT.fprintf oc "%s\n" indent; + ctx.verbatim <- verbatim_stack + end; + | BLOCK ( ("ifnottex" | "ifinfo" ), _ ) -> () + | BLOCK (name, blocks) -> (* TODO *) + + begin + match name with + | "cartouche" -> () + | _ -> + OUTPUT.fprintf oc + "%s\nERROR: uninterpreted block %S\n\n" indent name; + end; + + output_blocks ctx oc indent blocks + | ITEMS (name, header, lines)-> + + match name with + + | "table" -> + + let in_indent = indent ^ " " in + List.iteri (fun i (title, blocks) -> + + place_for_indexes ctx oc (if i = 0 then indent else in_indent) ; + + let style = String.sub header 1 ( String.length header - 1) in + let title = + if style = "asis" then + title + else + [ M (LOCATION.any, style, title)] + in + OUTPUT.fprintf oc "\n\n%s* %s\n\n" indent + (rst_of_line ctx title); + output_blocks ctx oc in_indent blocks; + OUTPUT.fprintf oc "%s\n" in_indent; + + ) lines + + | "enumerate" -> + + let in_indent = indent ^ " " in + List.iteri (fun i (title, blocks) -> + place_for_indexes ctx oc (if i = 0 then indent else in_indent) ; + OUTPUT.fprintf oc "\n\n%s#. %s\n\n" indent + (rst_of_line ctx title); + output_blocks ctx oc in_indent blocks; + OUTPUT.fprintf oc "%s\n" in_indent; + ) lines + + | "itemize" + | _ -> + + let in_indent = indent ^ " " in + List.iteri (fun i (title, blocks) -> + place_for_indexes ctx oc (if i = 0 then indent else in_indent) ; + OUTPUT.fprintf oc "\n\n%s* %s\n\n" indent + (rst_of_line ctx title); + output_blocks ctx oc in_indent blocks; + OUTPUT.fprintf oc "%s\n" indent; + ) lines + +let to_rst doc dir = + + let refs_external = + let anchors_file = doc.basename ^ ".anchors" in + let map = ref StringMap.empty in + if Sys.file_exists anchors_file then begin + let lines = EzFile.lines_of_file anchors_file in + Array.iter (fun line -> + let ref, line = EzString.cut_at line ' ' in + let anchor, text = EzString.cut_at line ' ' in + map := StringMap.add ref (anchor, text) !map; + ) lines + end; + !map + in + let pass ~gen_files + ?(line_indexes = Hashtbl.create 1000) + ?(line_anchors = Hashtbl.create 1000) + ?(anchors_created = StringSet.empty) + () = + let ctx = { + doc = doc ; + math = [ false ] ; + verbatim = [ Block ] ; + refs_allowed = None ; + refs_external ; + line_indexes ; + line_anchors ; + line = 0; + + files = [] ; + footnotes = [] ; + unknown_macros = StringMap.empty ; + refs_created = StringSet.empty ; + anchors_created ; + index_created = StringSet.empty ; + refs_used = StringMap.empty ; + new_line_indexes = Hashtbl.create 1000; + new_line_anchors = Hashtbl.create 1000; + } + in + + let chapters = ref 0 in + + let rst_header = {| +.. |_| unicode:: 0xA0 + :trim: + +.. role:: small-caps + :class: small-caps + +.. include:: + +|} + in + List.iter (fun block -> + + match block with + | BLOCK ( "copying", blocks ) -> + let file = "copying.rst" in + ctx.files <- file :: ctx.files ; + let oc = OUTPUT.open_out ( dir // file ) in + + OUTPUT.fprintf oc "%s" rst_header; + place_for_indexes ctx oc "" ; + output_level ctx oc 1 [ S "Copyright" ] ; + output_blocks ctx oc "" blocks ; + + List.iter (fun arg -> + OUTPUT.fprintf oc "\n\n.. [#] %s\n" arg; + ) ( List.rev ctx.footnotes ); + + if gen_files then OUTPUT.close_out oc + + + | LEVEL (1, number, title, blocks) -> + incr chapters ; + let file = Printf.sprintf "chapter%d.rst" !chapters in + ctx.files <- file :: ctx.files ; + ctx.footnotes <- [] ; + let oc = OUTPUT.open_out ( dir // file ) in + + OUTPUT.fprintf oc "%s" rst_header; + place_for_indexes ctx oc "" ; + output_level ctx oc 1 ?number title ; + output_blocks ctx oc "" blocks ; + + List.iter (fun arg -> + OUTPUT.fprintf oc "\n\n.. [#] %s\n" arg; + ) ( List.rev ctx.footnotes ); + + if gen_files then OUTPUT.close_out oc + | BLOCK ("ifnottex", _ ) -> () + | BLOCK ("ifinfo", _ ) -> () + | LINE line -> + Printf.eprintf "Discarding toplevel line %s\n%!" + ( string_of_line line ) + | EMPTY_LINE -> () + | _ -> + Printf.eprintf "ERROR:<<<\n%!"; + print_blocks stderr [block]; + Printf.eprintf ">>>\n%!"; + assert false + ) doc.content ; + + + ctx.files <- List.rev ctx.files ; + ctx + in + + let ctx = pass ~gen_files:false () in + let ctx = pass + ~gen_files:true + ~line_indexes:ctx.new_line_indexes + ~line_anchors:ctx.new_line_anchors + ~anchors_created:ctx.anchors_created + () in + let files = ctx.files in + + let oc = OUTPUT.open_out ( dir // "index.rst" ) in + let title = string_of_line ( match doc.title with + | None -> assert false + | Some title -> title ) + in + + OUTPUT.fprintf oc "%s\n" + ( String.concat "\n" + ( + [ ".. gnucobol documentation master file"; + ""; + title; + String.make ( String.length title ) '=' ; + ""; + "This documentation is published by OCamlPro SAS on our `resources page for GnuCOBOL `_."; + "" ; + "Authors:" ; + ""; + ] @ + List.map (fun author -> + Printf.sprintf "* %s" @@ rst_of_line ctx author) doc.authors + @ [ + ""; + ".. toctree::"; + " :maxdepth: 2"; + " :caption: Documentation"; + ""; + ])); + List.iter (fun file -> + OUTPUT.fprintf oc " %s\n" ( Filename.chop_suffix file ".rst")) + files; + + OUTPUT.fprintf oc "%s\n" + ( String.concat "\n" + [ + ""; + "Indices and tables"; + "=================="; + ""; + "* :ref:`genindex`"; + "* :ref:`modindex`"; + "" + ]); + OUTPUT.close_out oc; + + StringMap.iter (fun label loc -> + if not ( StringSet.mem label ctx.refs_created ) then + Printf.eprintf "%s: undefined label %S\n%!" + ( LOCATION.to_string loc ) label + ) ctx.refs_used ; + + () + +let action ~filename ?target () = + + let doc = read filename in + match target with + | None -> + print_doc doc + | Some dir -> + print_doc doc ~dir ; + to_rst doc dir + + +let cmd = + let filename = ref None in + let target = ref None in + EZCMD.sub + "texi2rst" + (fun () -> + match !filename with + | None -> Fatal.error "You must specify a filename" + | Some filename -> action ~filename ?target:!target () + ) + ~args: + [ + [ "o" ], Arg.String (fun s -> target := Some s), + EZCMD.info ~docv:"DIR" "Target directory for RST generation"; + + [], + Arg.Anon (0, fun s -> filename := Some s), + EZCMD.info ~docv:"FILE" ".texi file" + ] + ~doc: + "build .texi documentation from gnucobol-docs" + ~man:[ + `S "DESCRIPTION"; + `Blocks [ + `P "Build .texi documentation from gnucobol-docs." + ]; + ] diff --git a/src/lsp/superbol_free_lib/common_args.ml b/src/lsp/superbol_free_lib/common_args.ml new file mode 100644 index 000000000..b603bf54b --- /dev/null +++ b/src/lsp/superbol_free_lib/common_args.ml @@ -0,0 +1,141 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open EzCompat +open Ezcmd.V2 +open EZCMD.TYPES + +type t = { + config: (module Cobol_config.T); + source_format: Cobol_config.source_format_spec; + libpath: string list; + verbose: bool; + recovery: Cobol_parser.recovery; + show: [`Pending] list; +} + +let showable = + [ + ["pending"], `Pending; + ] + +let iter_comma_separated_spec ~showable ~option_name ~f spec = + EzString.split_simplify spec ',' |> + List.fold_left begin fun unknowns spec -> + let spec' = String.(lowercase_ascii @@ trim @@ spec) in + match + List.find_map begin fun (sl, tag) -> + if List.mem spec' sl then Some tag else None + end showable + with + | Some tag -> f tag; unknowns + | None -> StringSet.add spec unknowns + end StringSet.empty |> + fun unknowns -> + if not (StringSet.is_empty unknowns) then + raise @@ Stdlib.Arg.Bad + Pretty.(to_string "@[Unknown@ arguments@ for@ `%s':@ %a@]" + option_name + (list ~fopen:"" ~fsep:",@ " ~fclose:"" string) + (StringSet.elements unknowns)) + +let get () = + let conf = ref "" in (* Fixed by default *) + let dialect = ref None in + let strict = ref false in + let format = ref Cobol_config.Auto in (* Fixed by default *) + let formats = ["free"; "Free"; "FREE"; + "fixed"; "Fixed"; "FIXED"; + "cobolx"; "Cobolx"; "CobolX"; "COBOLX"] in + let libpath = ref ["."] in + let recovery = ref true in + let show = ref [`Pending] in (* default *) + let silence spec = + iter_comma_separated_spec ~showable ~option_name:"--silence" spec + ~f:(fun tag -> show := List.filter ((<>) tag) !show) + in + + let args = [ + + ["conf"], Arg.Set_string conf, + EZCMD.info ~docv:"CONF_FILE" "Set the configuration file to be used"; + + ["dialect"; "std"], Arg.Symbol + (Cobol_config.DIALECT.all_canonical_names, + fun d -> dialect := Some (Cobol_config.DIALECT.of_string d)), + EZCMD.info ~docv:"DIALECT" + "Set the dialect to bu used (overriden by `--conf` if used)"; + + ["strict"], Arg.Set strict, + EZCMD.info "Use the strict configuration"; + + ["source-format"], + Arg.Symbol (formats, fun f -> format := match String.uppercase_ascii f with + | "FIXED" -> Cobol_config.SF Cobol_config.SFFixed + | "FREE" -> SF SFFree + | "COBOLX" -> SF SFCOBOLX + | _ -> + Cobol_common.Diagnostics.Now.warn + Fmt.stderr + "Unkown source format: %s, setting to default" + f; + Auto), + EZCMD.info ~docv:"SOURCE_FORMAT" + "Set the format of source code; allowed values are: { FIXED (the default), \ + FREE}\nOverrides `format` from configuration file if present."; + + ["free"], Arg.Unit (fun () -> format := SF SFFree), + EZCMD.info "Shorthand for `--source-format FREE`"; + + ["recovery"], Arg.Set_bool recovery, + EZCMD.info @@ + Pretty.to_string "Enable/disable parser recovery after syntax errors \ + (default: %b)" !recovery; + + ["silence"], Arg.String silence, + EZCMD.info "Silence specific messages"; + + ["I"], Arg.String (fun s -> libpath := s :: !libpath), + EZCMD.info ~docv:"DIRECTORY" "Add DIRECTORY to library search path"; + ] in + + + let get () = + let config = + let strict = !strict in + let dialect = !dialect in + match !conf, dialect with + | "", None -> Cobol_config.default + | "", Some d -> Cobol_common.do_any (Cobol_config.from_dialect ~strict) d + | s, None -> Cobol_common.do_any (Cobol_config.from_file ?dialect) s + | _ -> Pretty.failwith "Flags `--conf` and `--dialect` or `--std` cannot be \ + used together" + in + let source_format = + match !format with + | Auto -> + let module Config = (val config: Cobol_config.T) in + Config.format#value + | SF _ -> !format + in + let recovery = + if !recovery + then Cobol_parser.EnableRecovery { silence_benign_recoveries = false } + else Cobol_parser.DisableRecovery + in + let verbose = !Globals.verbosity > 0 in + { config ; source_format ; libpath = !libpath ; recovery; verbose; + show = !show } + + in + get, args diff --git a/src/lsp/superbol_free_lib/common_args.mli b/src/lsp/superbol_free_lib/common_args.mli new file mode 100644 index 000000000..e94db350a --- /dev/null +++ b/src/lsp/superbol_free_lib/common_args.mli @@ -0,0 +1,23 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +type t = { + config: (module Cobol_config.T); + source_format: Cobol_config.source_format_spec; + libpath: string list; + verbose: bool; + recovery: Cobol_parser.recovery; + show: [`Pending] list; +} + +val get : unit -> (unit -> t) * Ezcmd.V2.EZCMD.TYPES.arg_list diff --git a/src/lsp/superbol_free_lib/config.ml b/src/lsp/superbol_free_lib/config.ml new file mode 100644 index 000000000..9a15ceb8c --- /dev/null +++ b/src/lsp/superbol_free_lib/config.ml @@ -0,0 +1,14 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +let print () = () diff --git a/src/lsp/superbol_free_lib/dune b/src/lsp/superbol_free_lib/dune new file mode 100644 index 000000000..6702b3b45 --- /dev/null +++ b/src/lsp/superbol_free_lib/dune @@ -0,0 +1,26 @@ +; generated by drom from package skeleton 'library' + +(library + (name superbol_free_lib) + (public_name superbol_free_lib) + (wrapped true) + ; use field 'dune-libraries' to add libraries without opam deps + (libraries ez_file ez_cmdliner cobol_typeck cobol_parser cobol_lsp cobol_indent cobol_common cobol_ast ) + ; use field 'dune-flags' to set this value + (flags (:standard)) + ; use field 'dune-stanzas' to add more stanzas here + (preprocess (pps ppx_cobcflags)) + + ) + + +(rule + (targets version.ml) + (deps (:script version.mlt) package.toml) + (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{script})))) + +(documentation + (package superbol_free_lib)) + +; use field 'dune-trailer' to add more stuff here + diff --git a/src/lsp/superbol_free_lib/globals.ml b/src/lsp/superbol_free_lib/globals.ml new file mode 100644 index 000000000..57ecc0187 --- /dev/null +++ b/src/lsp/superbol_free_lib/globals.ml @@ -0,0 +1,34 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open Ezcmd.V2 + +let verbosity = ref 0 + +module MAIN = EZCMD.MAKE(struct + + let command = "superbol" + let about = {|superbol [SUBCOMMANDS] [ARGUMENTS]|} + let set_verbosity n = verbosity := n + let get_verbosity () = !verbosity + + let backtrace_var = Some "SUPERBOL_BACKTRACE" + let usage = + {| +swiss-knife for the COBOL language by OCamlPro" +|} + let version = Version.version + + exception Error = Cobol_common.FatalError + + end) diff --git a/src/lsp/superbol_free_lib/main.ml b/src/lsp/superbol_free_lib/main.ml new file mode 100644 index 000000000..e835ba8f0 --- /dev/null +++ b/src/lsp/superbol_free_lib/main.ml @@ -0,0 +1,36 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +(* +open Ezcmd.V2 +open EZCMD.TYPES +*) + +let public_subcommands = [ + Command_pp.cmd ; + Command_lsp.cmd; + Command_texi2rst.cmd ; + Command_indent_range.cmd; + Command_indent_file.cmd; +] + +let main ?style_renderer ?utf_8 () = + Printf.eprintf + "SuperBOL, Copyright OCamlPro. https://get-superbol.com. Affero GPL version.\n"; + Pretty.init_formatters ?style_renderer ?utf_8 (); + Globals.MAIN.main + (* ~on_error:Cobol_common.keep_temporary_files *) + ~on_exit:Cobol_common.exit + ~print_config:Config.print + ~common_args:[] + public_subcommands diff --git a/src/lsp/superbol_free_lib/package.toml b/src/lsp/superbol_free_lib/package.toml new file mode 100644 index 000000000..b0bd76ec0 --- /dev/null +++ b/src/lsp/superbol_free_lib/package.toml @@ -0,0 +1,85 @@ + +# name of package +name = "superbol_free_lib" +skeleton = "library" + +# version if different from project version +# version = "0.1.0" + +# synopsis if different from project synopsis +# synopsis = ... + +# description if different from project description +# description = ... + +# kind is either "library", "program" or "virtual" +kind = "library" + +# authors if different from project authors +# authors = [ "Me " ] + +# name of a file to generate with the current version +gen-version = "version.ml" + +# supported file generators are "ocamllex", "ocamlyacc" and "menhir" +# default is [ "ocamllex", "ocamlyacc" ] +# generators = [ "ocamllex", "menhir" ] + +# menhir options for the package +#Example: +#version = "2.0" +#parser = { modules = ["parser"]; tokens = "Tokens" } +#tokens = { modules = ["tokens"]} +# menhir = ... + +# whether all modules should be packed/wrapped (default is true) +# pack-modules = false + +# whether the package can be silently skipped if missing deps (default is false) +# optional = true + +# module name used to pack modules (if pack-modules is true) +# pack = "Mylib" + +# preprocessing options +# preprocess = "per-module (((action (run ./toto.sh %{input-file})) mod))" +preprocess = "pps ppx_cobcflags" + +# files to skip while updating at package level +skip = ["index.mld", "main.ml" ] + +# package library dependencies +# [dependencies] +# ez_file = ">=0.1 <1.3" +# base-unix = { libname = "unix", version = ">=base" } +[dependencies] +cobol_ast = "version" +cobol_common = "version" +cobol_indent = "version" +#cobol_linting = "version" +cobol_lsp = "version" +cobol_parser = "version" +cobol_typeck = "version" +#jcl_parser = "version" +ez_file = ">=0.3" +#ocabol_lib = "version" +#ppx_cobcflags = "version" +ez_cmdliner = "0.3.0" + +# package tools dependencies +[tools] +# ... + +# package fields (depends on package skeleton) +#Examples: +# dune-stanzas = "(preprocess (pps ppx_deriving_encoding))" +# dune-libraries = "bigstring" +# dune-trailer = "(install (..))" +# opam-trailer = "pin-depends: [..]" +# no-opam-test = "yes" +# no-opam-doc = "yes" +# gen-opam = "some" | "all" +# dune-stanzas = "(flags (:standard (:include linking.sexp)))" +# static-clibs = "unix" +[fields] +# ... diff --git a/src/lsp/superbol_free_lib/version.mlt b/src/lsp/superbol_free_lib/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/lsp/superbol_free_lib/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/interop-js-stubs/dune b/src/vscode/interop-js-stubs/dune similarity index 100% rename from src/interop-js-stubs/dune rename to src/vscode/interop-js-stubs/dune diff --git a/src/interop-js-stubs/interop.ml b/src/vscode/interop-js-stubs/interop.ml similarity index 80% rename from src/interop-js-stubs/interop.ml rename to src/vscode/interop-js-stubs/interop.ml index 4777dccbe..6a43d11a4 100644 --- a/src/interop-js-stubs/interop.ml +++ b/src/vscode/interop-js-stubs/interop.ml @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + let iter_set obj field f = function | Some value -> Ojs.set_prop_ascii obj field (f value) | None -> () diff --git a/src/interop-js-stubs/interop.mli b/src/vscode/interop-js-stubs/interop.mli similarity index 66% rename from src/interop-js-stubs/interop.mli rename to src/vscode/interop-js-stubs/interop.mli index d42a88c1a..b030a073d 100644 --- a/src/interop-js-stubs/interop.mli +++ b/src/vscode/interop-js-stubs/interop.mli @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + val iter_set : Ojs.t -> string -> ('a -> Ojs.t) -> 'a option -> unit type 'a or_undefined = 'a option diff --git a/src/interop-js-stubs/package.toml b/src/vscode/interop-js-stubs/package.toml similarity index 100% rename from src/interop-js-stubs/package.toml rename to src/vscode/interop-js-stubs/package.toml diff --git a/src/vscode/interop-js-stubs/version.mlt b/src/vscode/interop-js-stubs/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/interop-js-stubs/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/node-js-stubs/dune b/src/vscode/node-js-stubs/dune similarity index 100% rename from src/node-js-stubs/dune rename to src/vscode/node-js-stubs/dune diff --git a/src/node-js-stubs/node.ml b/src/vscode/node-js-stubs/node.ml similarity index 91% rename from src/node-js-stubs/node.ml rename to src/vscode/node-js-stubs/node.ml index ba4c0b66a..89013c131 100644 --- a/src/node-js-stubs/node.ml +++ b/src/vscode/node-js-stubs/node.ml @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop let __filename () = diff --git a/src/node-js-stubs/node.mli b/src/vscode/node-js-stubs/node.mli similarity index 82% rename from src/node-js-stubs/node.mli rename to src/vscode/node-js-stubs/node.mli index 8cd2579e1..d9bbf6139 100644 --- a/src/node-js-stubs/node.mli +++ b/src/vscode/node-js-stubs/node.mli @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop val __filename : unit -> string diff --git a/src/node-js-stubs/node_stub.js b/src/vscode/node-js-stubs/node_stub.js similarity index 100% rename from src/node-js-stubs/node_stub.js rename to src/vscode/node-js-stubs/node_stub.js diff --git a/src/node-js-stubs/package.toml b/src/vscode/node-js-stubs/package.toml similarity index 100% rename from src/node-js-stubs/package.toml rename to src/vscode/node-js-stubs/package.toml diff --git a/src/vscode/node-js-stubs/version.mlt b/src/vscode/node-js-stubs/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/node-js-stubs/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/polka-js-stubs/dune b/src/vscode/polka-js-stubs/dune similarity index 100% rename from src/polka-js-stubs/dune rename to src/vscode/polka-js-stubs/dune diff --git a/src/polka-js-stubs/package.toml b/src/vscode/polka-js-stubs/package.toml similarity index 100% rename from src/polka-js-stubs/package.toml rename to src/vscode/polka-js-stubs/package.toml diff --git a/src/polka-js-stubs/polka.ml b/src/vscode/polka-js-stubs/polka.ml similarity index 64% rename from src/polka-js-stubs/polka.ml rename to src/vscode/polka-js-stubs/polka.ml index bc69dad1d..a43490e98 100644 --- a/src/polka-js-stubs/polka.ml +++ b/src/vscode/polka-js-stubs/polka.ml @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop module Server = struct diff --git a/src/polka-js-stubs/polka.mli b/src/vscode/polka-js-stubs/polka.mli similarity index 53% rename from src/polka-js-stubs/polka.mli rename to src/vscode/polka-js-stubs/polka.mli index 93ea973e4..e7b429783 100644 --- a/src/polka-js-stubs/polka.mli +++ b/src/vscode/polka-js-stubs/polka.mli @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop module Server : sig diff --git a/src/polka-js-stubs/polka_stub.js b/src/vscode/polka-js-stubs/polka_stub.js similarity index 100% rename from src/polka-js-stubs/polka_stub.js rename to src/vscode/polka-js-stubs/polka_stub.js diff --git a/src/vscode/polka-js-stubs/version.mlt b/src/vscode/polka-js-stubs/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/polka-js-stubs/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/superbol-vscode-platform/debugger.ml b/src/vscode/superbol-vscode-platform/debugger.ml similarity index 90% rename from src/superbol-vscode-platform/debugger.ml rename to src/vscode/superbol-vscode-platform/debugger.ml index 2fc5543bf..9eb166012 100644 --- a/src/superbol-vscode-platform/debugger.ml +++ b/src/vscode/superbol-vscode-platform/debugger.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/superbol-vscode-platform/dune b/src/vscode/superbol-vscode-platform/dune similarity index 100% rename from src/superbol-vscode-platform/dune rename to src/vscode/superbol-vscode-platform/dune diff --git a/src/superbol-vscode-platform/linking_flags.sh b/src/vscode/superbol-vscode-platform/linking_flags.sh similarity index 100% rename from src/superbol-vscode-platform/linking_flags.sh rename to src/vscode/superbol-vscode-platform/linking_flags.sh diff --git a/src/superbol-vscode-platform/package.toml b/src/vscode/superbol-vscode-platform/package.toml similarity index 100% rename from src/superbol-vscode-platform/package.toml rename to src/vscode/superbol-vscode-platform/package.toml diff --git a/src/superbol-vscode-platform/superbol_languageclient.ml b/src/vscode/superbol-vscode-platform/superbol_languageclient.ml similarity index 84% rename from src/superbol-vscode-platform/superbol_languageclient.ml rename to src/vscode/superbol-vscode-platform/superbol_languageclient.ml index 301312975..008f44c4e 100644 --- a/src/superbol-vscode-platform/superbol_languageclient.ml +++ b/src/vscode/superbol-vscode-platform/superbol_languageclient.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) @@ -9,7 +12,6 @@ (* *) (**************************************************************************) - let command = Vscode.Workspace.getConfiguration () |> Vscode.WorkspaceConfiguration.get ~section:"superbol.path" diff --git a/src/superbol-vscode-platform/superbol_languageclient.mli b/src/vscode/superbol-vscode-platform/superbol_languageclient.mli similarity index 79% rename from src/superbol-vscode-platform/superbol_languageclient.mli rename to src/vscode/superbol-vscode-platform/superbol_languageclient.mli index c9f7b4404..7f49058f8 100644 --- a/src/superbol-vscode-platform/superbol_languageclient.mli +++ b/src/vscode/superbol-vscode-platform/superbol_languageclient.mli @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/superbol-vscode-platform/superbol_tasks.ml b/src/vscode/superbol-vscode-platform/superbol_tasks.ml similarity index 95% rename from src/superbol-vscode-platform/superbol_tasks.ml rename to src/vscode/superbol-vscode-platform/superbol_tasks.ml index 384392d07..3ebd6dce4 100644 --- a/src/superbol-vscode-platform/superbol_tasks.ml +++ b/src/vscode/superbol-vscode-platform/superbol_tasks.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/superbol-vscode-platform/superbol_tasks.mli b/src/vscode/superbol-vscode-platform/superbol_tasks.mli similarity index 78% rename from src/superbol-vscode-platform/superbol_tasks.mli rename to src/vscode/superbol-vscode-platform/superbol_tasks.mli index c2eb7927c..2395b0399 100644 --- a/src/superbol-vscode-platform/superbol_tasks.mli +++ b/src/vscode/superbol-vscode-platform/superbol_tasks.mli @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/superbol-vscode-platform/superbol_vscode_platform.ml b/src/vscode/superbol-vscode-platform/superbol_vscode_platform.ml similarity index 96% rename from src/superbol-vscode-platform/superbol_vscode_platform.ml rename to src/vscode/superbol-vscode-platform/superbol_vscode_platform.ml index 96842e73d..6ad104543 100644 --- a/src/superbol-vscode-platform/superbol_vscode_platform.ml +++ b/src/vscode/superbol-vscode-platform/superbol_vscode_platform.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/superbol-vscode-platform/superbol_vscode_platform.mli b/src/vscode/superbol-vscode-platform/superbol_vscode_platform.mli similarity index 77% rename from src/superbol-vscode-platform/superbol_vscode_platform.mli rename to src/vscode/superbol-vscode-platform/superbol_vscode_platform.mli index 83af3170b..7068ab6ba 100644 --- a/src/superbol-vscode-platform/superbol_vscode_platform.mli +++ b/src/vscode/superbol-vscode-platform/superbol_vscode_platform.mli @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode/superbol-vscode-platform/version.mlt b/src/vscode/superbol-vscode-platform/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/superbol-vscode-platform/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/vscode-debugadapter/debugSession.ml b/src/vscode/vscode-debugadapter/debugSession.ml similarity index 81% rename from src/vscode-debugadapter/debugSession.ml rename to src/vscode/vscode-debugadapter/debugSession.ml index fe3888b61..af1218e89 100644 --- a/src/vscode-debugadapter/debugSession.ml +++ b/src/vscode/vscode-debugadapter/debugSession.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-debugadapter/dune b/src/vscode/vscode-debugadapter/dune similarity index 100% rename from src/vscode-debugadapter/dune rename to src/vscode/vscode-debugadapter/dune diff --git a/src/vscode-debugadapter/messages.ml b/src/vscode/vscode-debugadapter/messages.ml similarity index 87% rename from src/vscode-debugadapter/messages.ml rename to src/vscode/vscode-debugadapter/messages.ml index 9950c44b2..71cea2395 100644 --- a/src/vscode-debugadapter/messages.ml +++ b/src/vscode/vscode-debugadapter/messages.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-debugadapter/package.toml b/src/vscode/vscode-debugadapter/package.toml similarity index 100% rename from src/vscode-debugadapter/package.toml rename to src/vscode/vscode-debugadapter/package.toml diff --git a/src/vscode-debugadapter/protocol.ml b/src/vscode/vscode-debugadapter/protocol.ml similarity index 93% rename from src/vscode-debugadapter/protocol.ml rename to src/vscode/vscode-debugadapter/protocol.ml index a6e0980ef..ffe9a54f2 100644 --- a/src/vscode-debugadapter/protocol.ml +++ b/src/vscode/vscode-debugadapter/protocol.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode/vscode-debugadapter/version.mlt b/src/vscode/vscode-debugadapter/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/vscode-debugadapter/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/vscode-debugadapter/vscode_debugadapter_stub.js b/src/vscode/vscode-debugadapter/vscode_debugadapter_stub.js similarity index 100% rename from src/vscode-debugadapter/vscode_debugadapter_stub.js rename to src/vscode/vscode-debugadapter/vscode_debugadapter_stub.js diff --git a/src/vscode-debugprotocol/debugProtocol.ml b/src/vscode/vscode-debugprotocol/debugProtocol.ml similarity index 99% rename from src/vscode-debugprotocol/debugProtocol.ml rename to src/vscode/vscode-debugprotocol/debugProtocol.ml index a23dfec32..03f062fd3 100644 --- a/src/vscode-debugprotocol/debugProtocol.ml +++ b/src/vscode/vscode-debugprotocol/debugProtocol.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-debugprotocol/dune b/src/vscode/vscode-debugprotocol/dune similarity index 100% rename from src/vscode-debugprotocol/dune rename to src/vscode/vscode-debugprotocol/dune diff --git a/src/vscode-debugprotocol/package.toml b/src/vscode/vscode-debugprotocol/package.toml similarity index 100% rename from src/vscode-debugprotocol/package.toml rename to src/vscode/vscode-debugprotocol/package.toml diff --git a/src/vscode/vscode-debugprotocol/version.mlt b/src/vscode/vscode-debugprotocol/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/vscode-debugprotocol/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/vscode-debugprotocol/vscode_debugprotocol_stub.js b/src/vscode/vscode-debugprotocol/vscode_debugprotocol_stub.js similarity index 100% rename from src/vscode-debugprotocol/vscode_debugprotocol_stub.js rename to src/vscode/vscode-debugprotocol/vscode_debugprotocol_stub.js diff --git a/src/vscode-js-stubs/dune b/src/vscode/vscode-js-stubs/dune similarity index 100% rename from src/vscode-js-stubs/dune rename to src/vscode/vscode-js-stubs/dune diff --git a/src/vscode-js-stubs/package.toml b/src/vscode/vscode-js-stubs/package.toml similarity index 100% rename from src/vscode-js-stubs/package.toml rename to src/vscode/vscode-js-stubs/package.toml diff --git a/src/vscode-js-stubs/typings.ml b/src/vscode/vscode-js-stubs/typings.ml similarity index 87% rename from src/vscode-js-stubs/typings.ml rename to src/vscode/vscode-js-stubs/typings.ml index c772eb54a..2750ad61a 100644 --- a/src/vscode-js-stubs/typings.ml +++ b/src/vscode/vscode-js-stubs/typings.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode/vscode-js-stubs/version.mlt b/src/vscode/vscode-js-stubs/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/vscode-js-stubs/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/vscode-js-stubs/vscode.ml b/src/vscode/vscode-js-stubs/vscode.ml similarity index 98% rename from src/vscode-js-stubs/vscode.ml rename to src/vscode/vscode-js-stubs/vscode.ml index 50c5a07c5..e6a127511 100644 --- a/src/vscode-js-stubs/vscode.ml +++ b/src/vscode/vscode-js-stubs/vscode.ml @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop include [%js: val version : string [@@js.global "vscode.version"]] diff --git a/src/vscode-js-stubs/vscode.mli b/src/vscode/vscode-js-stubs/vscode.mli similarity index 98% rename from src/vscode-js-stubs/vscode.mli rename to src/vscode/vscode-js-stubs/vscode.mli index 21d0c968d..e12ed4591 100644 --- a/src/vscode-js-stubs/vscode.mli +++ b/src/vscode/vscode-js-stubs/vscode.mli @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop val version : string diff --git a/src/vscode-js-stubs/vscode_stub.js b/src/vscode/vscode-js-stubs/vscode_stub.js similarity index 100% rename from src/vscode-js-stubs/vscode_stub.js rename to src/vscode/vscode-js-stubs/vscode_stub.js diff --git a/src/vscode-json/dune b/src/vscode/vscode-json/dune similarity index 100% rename from src/vscode-json/dune rename to src/vscode/vscode-json/dune diff --git a/src/vscode-json/grammar.ml b/src/vscode/vscode-json/grammar.ml similarity index 98% rename from src/vscode-json/grammar.ml rename to src/vscode/vscode-json/grammar.ml index 1abae668a..46998756c 100644 --- a/src/vscode-json/grammar.ml +++ b/src/vscode/vscode-json/grammar.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/index.mld b/src/vscode/vscode-json/index.mld similarity index 100% rename from src/vscode-json/index.mld rename to src/vscode/vscode-json/index.mld diff --git a/src/vscode-json/language.ml b/src/vscode/vscode-json/language.ml similarity index 89% rename from src/vscode-json/language.ml rename to src/vscode/vscode-json/language.ml index 841df7c8e..0944e4ea4 100644 --- a/src/vscode-json/language.ml +++ b/src/vscode/vscode-json/language.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/linking_flags.sh b/src/vscode/vscode-json/linking_flags.sh similarity index 100% rename from src/vscode-json/linking_flags.sh rename to src/vscode/vscode-json/linking_flags.sh diff --git a/src/vscode-json/main.ml b/src/vscode/vscode-json/main.ml similarity index 96% rename from src/vscode-json/main.ml rename to src/vscode/vscode-json/main.ml index a71b8c15c..9c6a50f51 100644 --- a/src/vscode-json/main.ml +++ b/src/vscode/vscode-json/main.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/main.mli b/src/vscode/vscode-json/main.mli similarity index 82% rename from src/vscode-json/main.mli rename to src/vscode/vscode-json/main.mli index 35c66a392..48a9a469a 100644 --- a/src/vscode-json/main.mli +++ b/src/vscode/vscode-json/main.mli @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/manifest.ml b/src/vscode/vscode-json/manifest.ml similarity index 98% rename from src/vscode-json/manifest.ml rename to src/vscode/vscode-json/manifest.ml index 6e4a14fae..8701a6eb2 100644 --- a/src/vscode-json/manifest.ml +++ b/src/vscode/vscode-json/manifest.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/package.toml b/src/vscode/vscode-json/package.toml similarity index 100% rename from src/vscode-json/package.toml rename to src/vscode/vscode-json/package.toml diff --git a/src/vscode-json/snippets.ml b/src/vscode/vscode-json/snippets.ml similarity index 83% rename from src/vscode-json/snippets.ml rename to src/vscode/vscode-json/snippets.ml index b41698fc0..b52a94fed 100644 --- a/src/vscode-json/snippets.ml +++ b/src/vscode/vscode-json/snippets.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/tasks.ml b/src/vscode/vscode-json/tasks.ml similarity index 98% rename from src/vscode-json/tasks.ml rename to src/vscode/vscode-json/tasks.ml index 8bb6779dc..9d5ee472b 100644 --- a/src/vscode-json/tasks.ml +++ b/src/vscode/vscode-json/tasks.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-json/tests/README.md b/src/vscode/vscode-json/tests/README.md similarity index 100% rename from src/vscode-json/tests/README.md rename to src/vscode/vscode-json/tests/README.md diff --git a/src/vscode-json/tests/extensions.json b/src/vscode/vscode-json/tests/extensions.json similarity index 100% rename from src/vscode-json/tests/extensions.json rename to src/vscode/vscode-json/tests/extensions.json diff --git a/src/vscode-json/tests/launch-nodejs.json b/src/vscode/vscode-json/tests/launch-nodejs.json similarity index 100% rename from src/vscode-json/tests/launch-nodejs.json rename to src/vscode/vscode-json/tests/launch-nodejs.json diff --git a/src/vscode-json/tests/launch.json b/src/vscode/vscode-json/tests/launch.json similarity index 100% rename from src/vscode-json/tests/launch.json rename to src/vscode/vscode-json/tests/launch.json diff --git a/src/vscode-json/tests/settings.json b/src/vscode/vscode-json/tests/settings.json similarity index 100% rename from src/vscode-json/tests/settings.json rename to src/vscode/vscode-json/tests/settings.json diff --git a/src/vscode-json/tests/shared.code-snippets b/src/vscode/vscode-json/tests/shared.code-snippets similarity index 100% rename from src/vscode-json/tests/shared.code-snippets rename to src/vscode/vscode-json/tests/shared.code-snippets diff --git a/src/vscode-json/tests/tasks.json b/src/vscode/vscode-json/tests/tasks.json similarity index 100% rename from src/vscode-json/tests/tasks.json rename to src/vscode/vscode-json/tests/tasks.json diff --git a/src/vscode/vscode-json/version.mlt b/src/vscode/vscode-json/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/vscode-json/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/vscode-languageclient-js-stubs/dune b/src/vscode/vscode-languageclient-js-stubs/dune similarity index 100% rename from src/vscode-languageclient-js-stubs/dune rename to src/vscode/vscode-languageclient-js-stubs/dune diff --git a/src/vscode-languageclient-js-stubs/package.toml b/src/vscode/vscode-languageclient-js-stubs/package.toml similarity index 100% rename from src/vscode-languageclient-js-stubs/package.toml rename to src/vscode/vscode-languageclient-js-stubs/package.toml diff --git a/src/vscode/vscode-languageclient-js-stubs/version.mlt b/src/vscode/vscode-languageclient-js-stubs/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/vscode-languageclient-js-stubs/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + () diff --git a/src/vscode-languageclient-js-stubs/vscode_languageclient.ml b/src/vscode/vscode-languageclient-js-stubs/vscode_languageclient.ml similarity index 82% rename from src/vscode-languageclient-js-stubs/vscode_languageclient.ml rename to src/vscode/vscode-languageclient-js-stubs/vscode_languageclient.ml index ca3b71456..61d74b2b2 100644 --- a/src/vscode-languageclient-js-stubs/vscode_languageclient.ml +++ b/src/vscode/vscode-languageclient-js-stubs/vscode_languageclient.ml @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop module RevealOutputChannelOn = struct diff --git a/src/vscode-languageclient-js-stubs/vscode_languageclient.mli b/src/vscode/vscode-languageclient-js-stubs/vscode_languageclient.mli similarity index 77% rename from src/vscode-languageclient-js-stubs/vscode_languageclient.mli rename to src/vscode/vscode-languageclient-js-stubs/vscode_languageclient.mli index 9894a1977..b6fe9ffda 100644 --- a/src/vscode-languageclient-js-stubs/vscode_languageclient.mli +++ b/src/vscode/vscode-languageclient-js-stubs/vscode_languageclient.mli @@ -1,3 +1,17 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) +(* Copyright (c) 2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the MIT license found in the *) +(* LICENSE.md file in the root directory of this source tree. *) +(* *) +(* *) +(**************************************************************************) + open Interop module RevealOutputChannelOn : sig diff --git a/src/vscode-languageclient-js-stubs/vscode_languageclient_stub.js b/src/vscode/vscode-languageclient-js-stubs/vscode_languageclient_stub.js similarity index 100% rename from src/vscode-languageclient-js-stubs/vscode_languageclient_stub.js rename to src/vscode/vscode-languageclient-js-stubs/vscode_languageclient_stub.js diff --git a/src/vscode-package-json/dune b/src/vscode/vscode-package-json/dune similarity index 100% rename from src/vscode-package-json/dune rename to src/vscode/vscode-package-json/dune diff --git a/src/vscode-package-json/linking_flags.sh b/src/vscode/vscode-package-json/linking_flags.sh similarity index 100% rename from src/vscode-package-json/linking_flags.sh rename to src/vscode/vscode-package-json/linking_flags.sh diff --git a/src/vscode-package-json/main.ml b/src/vscode/vscode-package-json/main.ml similarity index 88% rename from src/vscode-package-json/main.ml rename to src/vscode/vscode-package-json/main.ml index 81cdec88f..4b608eb81 100644 --- a/src/vscode-package-json/main.ml +++ b/src/vscode/vscode-package-json/main.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-package-json/package.toml b/src/vscode/vscode-package-json/package.toml similarity index 100% rename from src/vscode-package-json/package.toml rename to src/vscode/vscode-package-json/package.toml diff --git a/src/vscode-package-json/project.ml b/src/vscode/vscode-package-json/project.ml similarity index 99% rename from src/vscode-package-json/project.ml rename to src/vscode/vscode-package-json/project.ml index 7120ff364..b21bbfe74 100644 --- a/src/vscode-package-json/project.ml +++ b/src/vscode/vscode-package-json/project.ml @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode-package-json/project.mli b/src/vscode/vscode-package-json/project.mli similarity index 77% rename from src/vscode-package-json/project.mli rename to src/vscode/vscode-package-json/project.mli index 03b911e0b..88a911e1d 100644 --- a/src/vscode-package-json/project.mli +++ b/src/vscode/vscode-package-json/project.mli @@ -1,5 +1,8 @@ (**************************************************************************) (* *) +(* SuperBOL OSS Studio *) +(* *) +(* *) (* Copyright (c) 2023 OCamlPro SAS *) (* *) (* All rights reserved. *) diff --git a/src/vscode/vscode-package-json/version.mlt b/src/vscode/vscode-package-json/version.mlt new file mode 100644 index 000000000..1bcf00592 --- /dev/null +++ b/src/vscode/vscode-package-json/version.mlt @@ -0,0 +1,30 @@ +#!/usr/bin/env ocaml +;; +#load "unix.cma" + +let query cmd = + let chan = Unix.open_process_in cmd in + try + let out = input_line chan in + if Unix.close_process_in chan = Unix.WEXITED 0 then + Some out + else None + with End_of_file -> None + +let commit_hash = query "git show -s --pretty=format:%H" +let commit_date = query "git show -s --pretty=format:%ci" +let version = "0.1.0" + +let string_option = function + | None -> "None" + | Some s -> Printf.sprintf "Some %S" s + +let () = + Format.printf "@["; + Format.printf "let version = %S@," version; + Format.printf + "let commit_hash = %s@," (string_option commit_hash); + Format.printf + "let commit_date = %s@," (string_option commit_date); + Format.printf "@]@."; + ()