TCL regexp表达式可捕获方括号中的单词

Question

I want to parse: ([(A touch B) over C] touch {D touch E}) is good .

Using: ( P1 touch P2) is good .

I want to replace P1 and P2 by regular expression to get P1 = [(A touch B) over C] P2 = {D touch E} My first idea is: ( (.*) touch (.*)) is good .

But i got wrong matching: P1 = [(A touch B) over C] touch {D P2 = E}

I want to break on the "touch" outside the brackets. Note: A, B, C... are examples so we should use .*

Answer 1

A regular expression matching can't handle arbitrary expressions of this kind, but most parsers can. In the Tcllib standard library for Tcl there is a PEG (parsing expression grammar) parser generator in the pt (parser tools) module. The following defines a grammar (as a simple string) that can parse your example text, and also text where brackets of the same kind are nested:

set grammar {
PEG Reader (Datum)
      Datum       <- '(' <space>* P1 'touch' <space>* P2 ') is good' ;
      Word        <- <alpha>+ ;
      BrackExpr   <- '[' Expression+ ']' ;
      BraceExpr   <- '{' Expression+ '}' ;
      ParenExpr   <- '(' Expression+ ')' ;
void: Expression  <- (Word / BrackExpr / BraceExpr / ParenExpr) <space>* ;
      P1          <- Expression ;
      P2          <- Expression ;
END;
}

To use this, you need to follow some steps. First save the generated parser in a file:

package require fileutil
package require pt::pgen

fileutil::writeFile ./reader.tcl [pt::pgen peg $grammar oo -class Reader]

This code creates a file, reader.tcl, that contains a TclOO class that perform the parsing specified in the grammar. You source up that file to make the class available:

source reader.tcl

If you are going to do that multiple times from the console, you need to destroy the class in between:

catch {Reader destroy} ; source reader.tcl

Then you make an instance of the class and put it to work:

Reader create reader
set str {([(A touch B) over C] touch {D touch E}) is good}
reader parset $str

(If you use the parse method instead, you can parse an open channel.)

The result of the parsing is the AST (abstract syntax tree)

Datum 0 47 {P1 1 21} {P2 28 38}

As you can see, it has found text for P1 at string indices 1 to 21, and for P2 at 28 to 38 (note that trailing whitespace is captured). You can use string range $str 1 21 to get the text for P1, or automate it:

proc Datum {from to args} {foreach arg $args {puts [uplevel 1 $arg]}}
proc P1 {from to} {string range $::str $from $to}
proc P2 {from to} {string range $::str $from $to}

% Datum 0 47 {P1 1 21} {P2 28 38}
[(A touch B) over C]
{D touch E}

If you use this, you might want to experiment with the definition of the nonterminal Word . Currently it only allows alphabetic characters. A definition like

      Word        <- (<alnum> / [;:/&!?*+.\'\"#])+ ;

allows digits and some punctuation too. There are more inclusive character sets, but <punct> , <graph> , and <print> all contain bracket characters. Even if the definition of Expression is changed

void: Expression  <- (BrackExpr / BraceExpr / ParenExpr / Word) <space>* ;

so that Word comes last, which lets the parser choose one of the *Expr nonterminals on encountering an opening bracket, the closing bracket will still be consumed by Word and not by the correct nonterminal expression. AFAICT this is a limitation of PEG parsers, which do not backtrack. The grammar can be modified to deal with this, but it will very quickly become too complicated.

Documentation: pt (package)

Answer 2

You may use a regex pattern that will match either a [...] or {...} substrings before touch and then the same pattern after.

It will look like

\((\[[^][]*]|{[^{}]*}) touch (\[[^][]*]|{[^{}]*})\) is good

See the regex demo at regex101 . The (\\[[^][]*]|{[^{}]*}) construct is a capturing group that matches either a [ + 0+ chars other than [ and ] and then a ] or a { followed with 0+ chars other than { and } and then } .

One remark: there is no way to match nested balanced bracketed substrings with Tcl regex.

When using Tcl code, you may build the regex dynamically:

set txt {([(A touch B) over C] touch {D touch E}) is good}
set squares {\[[^][]*\]}
set braces {\{[^{}]*\}}
set cap "($squares|$braces)"
set rx "\\($cap touch $cap\\) is good"; 
lassign [lrange [regexp -all -inline $rx $txt] 1 end] P1 P2
puts "$P1 ::: $P2"

Output: [(A touch B) over C] ::: {D touch E} .

See the Tcl online demo .