Added #:cut pattern directive

pkgs/racket-doc/syntax/scribblings/parse/stxclasses.scrbl

@@ -350,6 +350,14 @@ example.
 Equivalent to @racket[#:and (~undo defn-or-expr ...)].
 }
 
+@specsubform[(code:line #:cut)]{
+
+Eliminates backtracking choice points and commits parsing to the
+current branch at the current point.
+
+Equivalent to @racket[#:and ~!].
+}
+
 
 @;{----------}
 

pkgs/racket-test/tests/stxparse/test.rkt

@@ -535,6 +535,17 @@
       (check-equal? (reverse (lits)) '(a c))))
   )
 
+;; #:cut
+
+(test-case "#:cut after pattern"
+  (check-exn #rx"correct exn"
+             (lambda ()
+               (syntax-parse #'#t
+                 [b #:cut
+                    #:fail-when (syntax-e #'b) "correct exn"
+                    (values)]
+                 [_ (error "wrong exn")]))))
+
 ;; state unwinding
 
 (let ()

racket/collects/syntax/parse/private/rep.rkt

@@ -1267,6 +1267,9 @@
     [(cons (list '#:undo undo-stx stmts) rest)
      (cons (action:undo stmts)
            (parse-pattern-sides rest decls))]
+    [(cons (list '#:cut cut-stx) rest)
+     (cons (action:cut)
+           (parse-pattern-sides rest decls))]
     ['()
      '()]))
 
@@ -1632,7 +1635,8 @@
         (list '#:and check-expression)
         (list '#:post check-expression)
         (list '#:do check-stmt-list)
-        (list '#:undo check-stmt-list)))
+        (list '#:undo check-stmt-list)
+        (list '#:cut)))
 
 ;; fail-directive-table
 (define fail-directive-table