├── .github └── workflows │ ├── linux.yml │ ├── macos.yml │ └── windows.yml ├── .gitignore ├── Changes ├── LICENSE ├── META6.json ├── README.md ├── dist.ini ├── lib └── Grammar │ ├── Debugger.rakumod │ ├── Debugger │ └── WrapCache.rakumod │ └── Tracer.rakumod ├── run-tests └── t ├── debugger.rakutest ├── ltm.rakutest └── tracer.rakutest /.github/workflows/linux.yml: -------------------------------------------------------------------------------- 1 | name: Linux 2 | 3 | on: 4 | push: 5 | branches: 6 | - '*' 7 | tags-ignore: 8 | - '*' 9 | pull_request: 10 | 11 | jobs: 12 | raku: 13 | strategy: 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | raku-version: 18 | - 'latest' 19 | runs-on: ${{ matrix.os }} 20 | steps: 21 | - uses: actions/checkout@v3 22 | - uses: Raku/setup-raku@v1 23 | with: 24 | raku-version: ${{ matrix.raku-version }} 25 | - name: Install Dependencies 26 | run: zef install --/test --test-depends --deps-only . 27 | - name: Run Special Tests 28 | run: raku run-tests -i 29 | -------------------------------------------------------------------------------- /.github/workflows/macos.yml: -------------------------------------------------------------------------------- 1 | name: MacOS 2 | 3 | on: 4 | push: 5 | branches: 6 | - '*' 7 | tags-ignore: 8 | - '*' 9 | pull_request: 10 | 11 | jobs: 12 | raku: 13 | strategy: 14 | matrix: 15 | os: 16 | - macos-latest 17 | raku-version: 18 | - 'latest' 19 | runs-on: ${{ matrix.os }} 20 | steps: 21 | - uses: actions/checkout@v3 22 | - uses: Raku/setup-raku@v1 23 | with: 24 | raku-version: ${{ matrix.raku-version }} 25 | - name: Install Dependencies 26 | run: zef install --/test --test-depends --deps-only . 27 | - name: Run Special Tests 28 | run: raku run-tests -i 29 | -------------------------------------------------------------------------------- /.github/workflows/windows.yml: -------------------------------------------------------------------------------- 1 | name: Windows 2 | 3 | on: 4 | push: 5 | branches: 6 | - '*' 7 | tags-ignore: 8 | - '*' 9 | pull_request: 10 | 11 | jobs: 12 | raku: 13 | strategy: 14 | matrix: 15 | os: 16 | - windows-latest 17 | raku-version: 18 | - 'latest' 19 | runs-on: ${{ matrix.os }} 20 | steps: 21 | - uses: actions/checkout@v3 22 | - uses: Raku/setup-raku@v1 23 | with: 24 | raku-version: ${{ matrix.raku-version }} 25 | - name: Install Dependencies 26 | run: zef install --/test --test-depends --deps-only . 27 | - name: Run Special Tests 28 | run: raku run-tests -i 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .precomp/ 2 | /Grammar-Debugger-* 3 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Grammar::Debugger 2 | 3 | {{$NEXT}} 4 | 5 | 1.0.2 2024-12-11T20:01:48+01:00 6 | - Initial version as a Raku Community module 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | -------------------------------------------------------------------------------- /META6.json: -------------------------------------------------------------------------------- 1 | { 2 | "auth": "zef:raku-community-modules", 3 | "build-depends": [ 4 | "Terminal::ANSIColor" 5 | ], 6 | "creator": "Jonathan Worthington", 7 | "depends": [ 8 | "Terminal::ANSIColor" 9 | ], 10 | "description": "Interactive debugger for Raku grammars", 11 | "license": "Artistic-2.0", 12 | "name": "Grammar::Debugger", 13 | "perl": "6.*", 14 | "provides": { 15 | "Grammar::Debugger": "lib/Grammar/Debugger.rakumod", 16 | "Grammar::Debugger::WrapCache": "lib/Grammar/Debugger/WrapCache.rakumod", 17 | "Grammar::Tracer": "lib/Grammar/Tracer.rakumod" 18 | }, 19 | "resources": [ 20 | ], 21 | "source-url": "https://github.com/raku-community-modules/Grammar-Debugger.git", 22 | "tags": [ 23 | ], 24 | "test-depends": [ 25 | ], 26 | "version": "1.0.2" 27 | } 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Actions Status](https://github.com/raku-community-modules/Grammar-Debugger/actions/workflows/linux.yml/badge.svg)](https://github.com/raku-community-modules/Grammar-Debugger/actions) [![Actions Status](https://github.com/raku-community-modules/Grammar-Debugger/actions/workflows/macos.yml/badge.svg)](https://github.com/raku-community-modules/Grammar-Debugger/actions) [![Actions Status](https://github.com/raku-community-modules/Grammar-Debugger/actions/workflows/windows.yml/badge.svg)](https://github.com/raku-community-modules/Grammar-Debugger/actions) 2 | 3 | NAME 4 | ==== 5 | 6 | Grammer::Debugger - Interactive debugger for Raku grammars 7 | 8 | SYNOPSIS 9 | ======== 10 | 11 | In the file that has your grammar definition, merely load the module in the same lexical scope: 12 | 13 | ```raku 14 | use Grammar::Debugger; 15 | 16 | grammar Some::Grammar { ... } 17 | ``` 18 | 19 | DESCRIPTION 20 | =========== 21 | 22 | [Grammar::Debugger](Grammar::Debugger) is an interactive debugger for Raku grammars. It applies to all grammars in its lexical scope. When you run your program and start to parse a grammar, you should get an interactive prompt. Type `h` to get a list of commands: 23 | 24 | $ raku my-grammar-program.raku 25 | TOP 26 | > h 27 | r run (until breakpoint, if any) 28 | single step 29 | rf run until a match fails 30 | r run until rule is reached 31 | bp add add a rule name breakpoint 32 | bp list list all active rule name breakpoints 33 | bp rm remove a rule name breakpoint 34 | bp rm removes all breakpoints 35 | q quit 36 | > 37 | 38 | If you are debugging a grammar and want to set up breakpoints in code rather than entering them manually at the debug prompt, you can apply the breakpoint trait to any rule: 39 | 40 | ```raku 41 | token name is breakpoint { 42 | \w+ [\h+ \w+]* 43 | } 44 | ``` 45 | 46 | If you want to conditionally break, you can also do something like: 47 | 48 | ```raku 49 | token name will break { $_ eq 'Raku' } { 50 | \w+ [\h+ \w+]* 51 | } 52 | ``` 53 | 54 | Which will only break after the `name` token has matched "Raku". 55 | 56 | AUTHOR 57 | ====== 58 | 59 | Jonathan Worthington 60 | 61 | COPYRIGHT AND LICENSE 62 | ===================== 63 | 64 | Copyright 2011 - 2017 Jonathan Worthington 65 | 66 | Copyright 2024 Raku Community 67 | 68 | This library is free software; you can redistribute it and/or modify it under the Artistic License 2.0. 69 | 70 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Grammar::Debugger 2 | 3 | [ReadmeFromPod] 4 | filename = lib/Grammar/Debugger.rakumod 5 | 6 | [UploadToZef] 7 | 8 | [Badges] 9 | provider = github-actions/linux.yml 10 | provider = github-actions/macos.yml 11 | provider = github-actions/windows.yml 12 | -------------------------------------------------------------------------------- /lib/Grammar/Debugger.rakumod: -------------------------------------------------------------------------------- 1 | use Grammar::Debugger::WrapCache; 2 | use Terminal::ANSIColor; 3 | 4 | my enum InterventionPoint ; 5 | 6 | multi trait_mod:(Method $m, :$breakpoint!) is export { 7 | $m does role { method breakpoint { True } } 8 | } 9 | multi trait_mod:(Method $m, $cond, :$break!) is export { 10 | $m does role { 11 | has $.breakpoint-condition is rw; 12 | method breakpoint { True } 13 | } 14 | $m.breakpoint-condition = $cond; 15 | } 16 | 17 | my class DebuggedGrammarHOW is Metamodel::GrammarHOW does Grammar::Debugger::WrapCache { 18 | 19 | # Workaround for Rakudo* 2014.03.01 on Win (and maybe somewhere else, too): 20 | # trying to change the attributes in &intervene ... 21 | # ... yields # "Cannot modify an immutable value" 22 | # So we rather use the attribute $!state *the contents of which* we'll 23 | # modify instead. 24 | # Not as bad as it might look at first - maybe factor it out sometime. 25 | has $!state = ( 26 | auto-continue => False, 27 | indent => 0, 28 | stop-at-fail => False, 29 | stop-at-name => '', 30 | breakpoints => [], 31 | cond-breakpoints => ().hash, 32 | ).hash; 33 | 34 | method add_method(Mu $obj, $name, $code) { 35 | callsame; 36 | if $code.?breakpoint { 37 | if $code.?breakpoint-condition { 38 | $!state{'cond-breakpoints'}{$code.name} = $code.breakpoint-condition; 39 | } 40 | else { 41 | $!state{'breakpoints'}.push($code.name); 42 | } 43 | } 44 | } 45 | 46 | method find_method($obj, $name) { 47 | my \cached = %!cache{$name}; 48 | return cached if cached.DEFINITE; 49 | my $meth := callsame; 50 | if $meth.^name eq 'NQPRoutine' || $meth !~~ Any || $meth !~~ Regex { 51 | self!cache-unwrapped: $name, $meth; 52 | } 53 | else { 54 | self!cache-wrapped: $name, $meth, -> $c, |args { 55 | # Issue the rule's/token's/regex's name 56 | say ('| ' x $!state{'indent'}) ~ BOLD() ~ $name ~ RESET(); 57 | 58 | # Announce that we're about to enter the rule/token/regex 59 | self.intervene(EnterRule, $name); 60 | 61 | $!state{'indent'}++; 62 | # Actually call the rule/token/regex 63 | my $result := $meth($c, |args); 64 | $!state{'indent'}--; 65 | 66 | # Dump result. 67 | my $match := $result.MATCH; 68 | 69 | say ('| ' x $!state{'indent'}) ~ '* ' ~ 70 | (?$match ?? 71 | colored('MATCH', 'white on_green') ~ self.summary($match) !! 72 | colored('FAIL', 'white on_red')); 73 | 74 | # Announce that we're about to leave the rule/token/regex 75 | self.intervene(ExitRule, $name, :$match); 76 | $result 77 | } 78 | } 79 | } 80 | 81 | method intervene(InterventionPoint $point, $name, :$match) { 82 | # Any reason to stop? 83 | my $stop = 84 | !$!state{'auto-continue'} || 85 | $point == EnterRule && $name eq $!state{'stop-at-name'} || 86 | $point == ExitRule && !$match && $!state{'stop-at-fail'} || 87 | $point == EnterRule && $name eq any($!state{'breakpoints'}) || 88 | $point == ExitRule && $name eq any($!state{'cond-breakpoints'}.keys) 89 | && $!state{'cond-breakpoints'}{$name}.ACCEPTS($match); 90 | if $stop { 91 | my $done; 92 | repeat { 93 | my @parts = split /\s+/, prompt("> "); 94 | $done = True; 95 | given @parts[0] { 96 | when '' { 97 | $!state{'auto-continue'} = False; 98 | $!state{'stop-at-fail'} = False; 99 | $!state{'stop-at-name'} = ''; 100 | } 101 | when 'r' { 102 | given +@parts { 103 | when 1 { 104 | $!state{'auto-continue'} = True; 105 | $!state{'stop-at-fail'} = False; 106 | $!state{'stop-at-name'} = ''; 107 | } 108 | when 2 { 109 | $!state{'auto-continue'} = True; 110 | $!state{'stop-at-fail'} = False; 111 | $!state{'stop-at-name'} = @parts[1]; 112 | } 113 | default { 114 | usage(); 115 | $done = False; 116 | } 117 | } 118 | } 119 | when 'rf' { 120 | $!state{'auto-continue'} = True; 121 | $!state{'stop-at-fail'} = True; 122 | $!state{'stop-at-name'} = ''; 123 | } 124 | when 'bp' { 125 | if +@parts == 2 && @parts[1] eq 'list' { 126 | say "Current Breakpoints:\n" ~ 127 | $!state{'breakpoints'}.map({ " $_" }).join("\n"); 128 | } 129 | elsif +@parts == 3 && @parts[1] eq 'add' { 130 | unless $!state{'breakpoints'}.grep({ $_ eq @parts[2] }) { 131 | $!state{'breakpoints'}.push(@parts[2]); 132 | } 133 | } 134 | elsif +@parts == 3 && @parts[1] eq 'rm' { 135 | my @rm'd = $!state{'breakpoints'}.grep({ $_ ne @parts[2] }); 136 | if +@rm'd == +$!state{'breakpoints'} { 137 | say "No breakpoint '@parts[2]'"; 138 | } 139 | else { 140 | $!state{'breakpoints'} = @rm'd; 141 | } 142 | } 143 | elsif +@parts == 2 && @parts[1] eq 'rm' { 144 | $!state{'breakpoints'} = []; 145 | } 146 | else { 147 | usage(); 148 | } 149 | $done = False; 150 | } 151 | when 'q' { 152 | exit(0); 153 | } 154 | default { 155 | usage(); 156 | $done = False; 157 | } 158 | } 159 | } until $done; 160 | } 161 | } 162 | 163 | method summary($match) { 164 | my $snippet = $match.Str; 165 | my $sniplen = 60 - (3 * $!state{'indent'}); 166 | $sniplen > 0 ?? 167 | colored(' ' ~ $snippet.substr(0, $sniplen).perl, 'white') !! 168 | '' 169 | } 170 | 171 | sub usage() { 172 | say 173 | " r run (until breakpoint, if any)\n" ~ 174 | " single step\n" ~ 175 | " rf run until a match fails\n" ~ 176 | " r run until rule is reached\n" ~ 177 | " bp add add a rule name breakpoint\n" ~ 178 | " bp list list all active rule name breakpoints\n" ~ 179 | " bp rm remove a rule name breakpoint\n" ~ 180 | " bp rm removes all breakpoints\n" ~ 181 | " q quit" 182 | } 183 | 184 | method publish_method_cache($obj) { 185 | # Suppress this, so we always hit find_method. 186 | } 187 | } 188 | 189 | # Export this as the meta-class for the "grammar" package declarator. 190 | my module EXPORTHOW { 191 | constant grammar = DebuggedGrammarHOW; 192 | } 193 | 194 | =begin pod 195 | 196 | =head1 NAME 197 | 198 | Grammer::Debugger - Interactive debugger for Raku grammars 199 | 200 | =head1 SYNOPSIS 201 | 202 | In the file that has your grammar definition, merely load the module 203 | in the same lexical scope: 204 | 205 | =begin code :lang 206 | 207 | use Grammar::Debugger; 208 | 209 | grammar Some::Grammar { ... } 210 | 211 | =end code 212 | 213 | =head1 DESCRIPTION 214 | 215 | L is an interactive debugger for Raku grammars. 216 | It applies to all grammars in its lexical scope. When you run your 217 | program and start to parse a grammar, you should get an interactive 218 | prompt. Type C to get a list of commands: 219 | 220 | =begin code 221 | 222 | $ raku my-grammar-program.raku 223 | TOP 224 | > h 225 | r run (until breakpoint, if any) 226 | single step 227 | rf run until a match fails 228 | r run until rule is reached 229 | bp add add a rule name breakpoint 230 | bp list list all active rule name breakpoints 231 | bp rm remove a rule name breakpoint 232 | bp rm removes all breakpoints 233 | q quit 234 | > 235 | 236 | =end code 237 | 238 | If you are debugging a grammar and want to set up breakpoints in code 239 | rather than entering them manually at the debug prompt, you can apply 240 | the breakpoint trait to any rule: 241 | 242 | =begin code :lang 243 | 244 | token name is breakpoint { 245 | \w+ [\h+ \w+]* 246 | } 247 | 248 | =end code 249 | 250 | If you want to conditionally break, you can also do something like: 251 | 252 | =begin code :lang 253 | 254 | token name will break { $_ eq 'Raku' } { 255 | \w+ [\h+ \w+]* 256 | } 257 | 258 | =end code 259 | 260 | Which will only break after the C token has matched "Raku". 261 | 262 | =head1 AUTHOR 263 | 264 | Jonathan Worthington 265 | 266 | =head1 COPYRIGHT AND LICENSE 267 | 268 | Copyright 2011 - 2017 Jonathan Worthington 269 | 270 | Copyright 2024 Raku Community 271 | 272 | This library is free software; you can redistribute it and/or modify it under the Artistic License 2.0. 273 | 274 | =end pod 275 | 276 | # vim: expandtab shiftwidth=4 277 | -------------------------------------------------------------------------------- /lib/Grammar/Debugger/WrapCache.rakumod: -------------------------------------------------------------------------------- 1 | role Grammar::Debugger::WrapCache { 2 | has %!cache; 3 | 4 | method !cache-unwrapped(Str $name, Mu \unwrapped) { 5 | %!cache{$name} := unwrapped; 6 | unwrapped 7 | } 8 | 9 | method !cache-wrapped(Str $name, Mu \orig, \wrapped) { 10 | my role Forward { 11 | has Mu $.NFA; 12 | method SET-ORIG(Mu \orig --> Nil) { 13 | my Mu $raw-meth = orig.^lookup('NFA'); 14 | $!NFA := $raw-meth(orig); 15 | } 16 | } 17 | wrapped does Forward; 18 | wrapped.SET-ORIG(orig); 19 | %!cache{$name} := wrapped; 20 | wrapped 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /lib/Grammar/Tracer.rakumod: -------------------------------------------------------------------------------- 1 | use Grammar::Debugger::WrapCache; 2 | use Terminal::ANSIColor; 3 | 4 | =begin pod 5 | 6 | =head1 NAME 7 | 8 | Grammer::Tracer - non-interactive debugger for Perl 6 grammars 9 | 10 | =head1 SYNOPSIS 11 | 12 | In the file that has your grammar definition, merely load the module 13 | in the same lexical scope: 14 | 15 | use Grammar::Tracer; 16 | 17 | grammar Some::Grammar { ... } 18 | 19 | =head1 DESCRIPTION 20 | 21 | L is the non-interactive version of L. 22 | It runs through the entire grammar without stopping. 23 | 24 | =head1 AUTHOR 25 | 26 | Jonathan Worthington, C<< >> 27 | 28 | =end pod 29 | 30 | my class TracedGrammarHOW is Metamodel::GrammarHOW does Grammar::Debugger::WrapCache { 31 | my $indent = 0; 32 | 33 | method find_method($obj, $name) { 34 | my \cached = %!cache{$name}; 35 | return cached if cached.DEFINITE; 36 | my $meth := callsame; 37 | if $meth.^name eq 'NQPRoutine' || $meth !~~ Any || $meth !~~ Regex { 38 | self!cache-unwrapped: $name, $meth; 39 | } 40 | else { 41 | self!cache-wrapped: $name, $meth, -> $c, |args { 42 | # Method name. 43 | say ('| ' x $indent) ~ BOLD() ~ $name ~ RESET(); 44 | 45 | # Call rule. 46 | $indent++; 47 | my $result; 48 | try { 49 | $result := $meth($c, |args); 50 | CATCH { 51 | $indent--; 52 | } 53 | } 54 | $indent--; 55 | 56 | # Dump result. 57 | my $match := $result.MATCH; 58 | say ('| ' x $indent) ~ '* ' ~ 59 | ($result.MATCH ?? 60 | colored('MATCH', 'white on_green') ~ summary($match) !! 61 | colored('FAIL', 'white on_red')); 62 | $result 63 | } 64 | } 65 | } 66 | 67 | sub summary($match) { 68 | my $snippet = $match.Str; 69 | my $sniplen = 60 - (3 * $indent); 70 | $sniplen > 0 ?? 71 | colored(' ' ~ $snippet.substr(0, $sniplen).perl, 'white') !! 72 | '' 73 | } 74 | 75 | method publish_method_cache($obj) { 76 | # Suppress this, so we always hit find_method. 77 | } 78 | } 79 | 80 | # Export this as the meta-class for the "grammar" package declarator. 81 | my module EXPORTHOW { 82 | constant grammar = TracedGrammarHOW; 83 | } 84 | -------------------------------------------------------------------------------- /run-tests: -------------------------------------------------------------------------------- 1 | unit sub MAIN(:a($author), :i($install)); 2 | 3 | say run(, :out).out.slurp.chomp; 4 | say "Running on $*DISTRO.gist().\n"; 5 | 6 | say "Testing { 7 | "dist.ini".IO.lines.head.substr(7) 8 | }{ 9 | " including author tests" if $author 10 | }"; 11 | 12 | my @failed; 13 | my $done = 0; 14 | 15 | sub process($proc, $filename) { 16 | if $proc { 17 | $proc.out.slurp; 18 | } 19 | else { 20 | @failed.push($filename); 21 | if $proc.out.slurp -> $stdout { 22 | my @lines = $stdout.lines; 23 | with @lines.first( 24 | *.starts-with(" from gen/moar/stage2"),:k) 25 | -> $index { 26 | say @lines[^$index].join("\n"); 27 | } 28 | else { 29 | say $stdout; 30 | } 31 | } 32 | else { 33 | say "No output received, exit-code $proc.exitcode() ($proc.signal()):\n$proc.os-error()"; 34 | } 35 | } 36 | } 37 | 38 | sub install() { 39 | my $zef := $*DISTRO.is-win ?? 'zef.bat' !! 'zef'; 40 | my $proc := run $zef, "install", ".", "--verbose", "--/test", :out,:err,:merge; 41 | process($proc, "*installation*"); 42 | } 43 | 44 | sub test-dir($dir) { 45 | for $dir.IO.dir(:test(*.ends-with: '.t' | '.rakutest')).map(*.Str).sort { 46 | say "=== $_"; 47 | my $proc := run "raku", "--ll-exception", "-I.", $_, :out,:err,:merge; 48 | process($proc, $_); 49 | $done++; 50 | } 51 | } 52 | 53 | test-dir("t"); 54 | test-dir($_) for dir("t", :test({ !.starts-with(".") && "t/$_".IO.d})).map(*.Str).sort; 55 | test-dir("xt") if $author && "xt".IO.e; 56 | install if $install; 57 | 58 | if @failed { 59 | say "\nFAILED: {+@failed} of $done:"; 60 | say " $_" for @failed; 61 | exit +@failed; 62 | } 63 | 64 | say "\nALL {"$done " if $done > 1}OK"; 65 | 66 | # vim: expandtab shiftwidth=4 67 | -------------------------------------------------------------------------------- /t/debugger.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | use Grammar::Debugger; 3 | 4 | plan 1; 5 | 6 | grammar Sample { 7 | token TOP { } 8 | token foo { x } 9 | } 10 | 11 | lives-ok 12 | { 13 | #my $*OUT = class { method say(*@x) { }; method print(*@x) { }; method flush(*@x) { } }; 14 | #my $*IN = class { method get(*@x) { 'get'.say; "\n" } }; 15 | #Sample.parse('x') 16 | qw< the $*IN thing stopped working.. >; 17 | }, 18 | 'grammar.parse(...) with the debugger works'; 19 | 20 | # vim: expandtab shiftwidth=4 21 | -------------------------------------------------------------------------------- /t/ltm.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | 3 | use Grammar::Tracer; 4 | 5 | plan 1; 6 | 7 | # Test case taken from GitHub Issue #13 8 | 9 | grammar MyGrammar { 10 | proto token test { * } 11 | token test:sym { 12 | {} aa 13 | } 14 | token test:sym { 15 | aa 16 | } 17 | } 18 | 19 | class MyActions { 20 | method test:sym($/) { 21 | make 'wrong' 22 | } 23 | method test:sym($/) { 24 | make 'correct' 25 | } 26 | } 27 | 28 | my $outcome = do { 29 | my $*OUT = class { method say(*@x) { }; method print(*@x) { }; method flush(*@x) { } } 30 | MyGrammar.parse('aa', :rule, :actions(MyActions)).made 31 | } 32 | is $outcome, 'correct', 'Picked longest token'; 33 | 34 | # vim: expandtab shiftwidth=4 35 | -------------------------------------------------------------------------------- /t/tracer.rakutest: -------------------------------------------------------------------------------- 1 | use Test; 2 | 3 | use Grammar::Tracer; 4 | 5 | plan 1; 6 | 7 | grammar Sample { 8 | token TOP { } 9 | token foo { x } 10 | } 11 | 12 | lives-ok 13 | { 14 | my $*OUT = class { method say(*@x) { }; method print(*@x) { }; method flush(*@x) { } } 15 | Sample.parse('x') 16 | }, 17 | 'grammar.parse(...) with the tracer works'; 18 | 19 | # vim: expandtab shiftwidth=4 20 | --------------------------------------------------------------------------------