summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorEkaitz Zarraga <ekaitz@elenq.tech>2024-10-11 14:24:30 +0200
committerLudovic Courtès <ludo@gnu.org>2024-12-09 18:15:01 +0100
commit25504ba216a39247eb2dda168a45ad03c447b018 (patch)
tree50770606f443b1ccfadeb055c63d07e1d6271e40 /module
parentff11753df146d6a170521c898a8c784483c5c743 (diff)
downloadguile-25504ba216a39247eb2dda168a45ad03c447b018.tar.gz
PEG: Add support for `not-in-range` and [^...]
Modern PEG supports inversed class like `[^a-z]` that would get any character not in the `a-z` range. This commit adds support for that and also for a new `not-in-range` PEG pattern for scheme. * module/ice-9/peg/codegen.scm (cg-not-in-range): New function. * module/ice-9/peg/string-peg.scm: Add support for `[^...]` * test-suite/tests/peg.test: Test it. * doc/ref/api-peg.texi: Document accordingly. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/peg/codegen.scm22
-rw-r--r--module/ice-9/peg/string-peg.scm38
2 files changed, 57 insertions, 3 deletions
diff --git a/module/ice-9/peg/codegen.scm b/module/ice-9/peg/codegen.scm
index d80c3e849..82367ef55 100644
--- a/module/ice-9/peg/codegen.scm
+++ b/module/ice-9/peg/codegen.scm
@@ -140,6 +140,27 @@ return EXP."
((none) #`(list (1+ pos) '()))
(else (error "bad accum" accum))))))))))
+;; Generates code for matching a range of characters not between start and end.
+;; E.g.: (cg-not-in-range syntax #\a #\z 'body)
+(define (cg-not-in-range pat accum)
+ (syntax-case pat ()
+ ((start end)
+ (if (not (and (char? (syntax->datum #'start))
+ (char? (syntax->datum #'end))))
+ (error "range PEG should have characters after it; instead got"
+ #'start #'end))
+ #`(lambda (str len pos)
+ (and (< pos len)
+ (let ((c (string-ref str pos)))
+ (and (or (char<? c start) (char>? c end))
+ #,(case accum
+ ((all) #`(list (1+ pos)
+ (list 'cg-not-in-range (string c))))
+ ((name) #`(list (1+ pos) 'cg-not-in-range))
+ ((body) #`(list (1+ pos) (string c)))
+ ((none) #`(list (1+ pos) '()))
+ (else (error "bad accum" accum))))))))))
+
;; Generate code to match a pattern and do nothing with the result
(define (cg-ignore pat accum)
(syntax-case pat ()
@@ -304,6 +325,7 @@ return EXP."
(assq-set! peg-compiler-alist symbol function)))
(add-peg-compiler! 'range cg-range)
+(add-peg-compiler! 'not-in-range cg-not-in-range)
(add-peg-compiler! 'ignore cg-ignore)
(add-peg-compiler! 'capture cg-capture)
(add-peg-compiler! 'and cg-and)
diff --git a/module/ice-9/peg/string-peg.scm b/module/ice-9/peg/string-peg.scm
index 4b923220a..0026f8930 100644
--- a/module/ice-9/peg/string-peg.scm
+++ b/module/ice-9/peg/string-peg.scm
@@ -54,7 +54,7 @@ Prefix <-- (AND / NOT)? Suffix
Suffix <-- Primary (QUESTION / STAR / PLUS)?
Primary <-- Identifier !LEFTARROW
/ OPEN Expression CLOSE
- / Literal / Class / DOT
+ / Literal / Class / NotInClass / DOT
# Lexical syntax
Identifier <-- IdentStart IdentCont* Spacing
@@ -64,6 +64,7 @@ IdentCont <- IdentStart / [0-9]
Literal <-- SQUOTE (!SQUOTE Char)* SQUOTE Spacing
/ DQUOTE (!DQUOTE Char)* DQUOTE Spacing
+NotInClass <-- OPENBRACKET NOTIN (!CLOSEBRACKET Range)* CLOSEBRACKET Spacing
Class <-- OPENBRACKET !NOTIN (!CLOSEBRACKET Range)* CLOSEBRACKET Spacing
Range <-- Char DASH Char / Char
Char <-- '\\\\' [nrt'\"\\[\\]\\\\]
@@ -78,6 +79,7 @@ DQUOTE < [\"]
DASH < '-'
OPENBRACKET < '['
CLOSEBRACKET < ']'
+NOTIN < '^'
SLASH < '/' Spacing
AND <-- '&' Spacing
NOT <-- '!' Spacing
@@ -122,6 +124,7 @@ EndOfFile < !.
(and OPEN Expression CLOSE)
Literal
Class
+ NotInClass
DOT))
(define-sexp-parser Identifier all
(and IdentStart (* IdentCont) Spacing))
@@ -133,7 +136,11 @@ EndOfFile < !.
(or (and SQUOTE (* (and (not-followed-by SQUOTE) Char)) SQUOTE Spacing)
(and DQUOTE (* (and (not-followed-by DQUOTE) Char)) DQUOTE Spacing)))
(define-sexp-parser Class all
- (and OPENBRACKET (* (and (not-followed-by CLOSEBRACKET) Range)) CLOSEBRACKET Spacing))
+ (and OPENBRACKET (not-followed-by NOTIN)
+ (* (and (not-followed-by CLOSEBRACKET) Range)) CLOSEBRACKET Spacing))
+(define-sexp-parser NotInClass all
+ (and OPENBRACKET NOTIN
+ (* (and (not-followed-by CLOSEBRACKET) Range)) CLOSEBRACKET Spacing))
(define-sexp-parser Range all
(or (and Char DASH Char) Char))
(define-sexp-parser Char all
@@ -143,6 +150,8 @@ EndOfFile < !.
(and (not-followed-by "\\") peg-any)))
(define-sexp-parser LEFTARROW body
(and (or "<--" "<-" "<") Spacing)) ; NOTE: <-- and < are extensions
+(define-sexp-parser NOTIN none
+ (and "^"))
(define-sexp-parser SLASH none
(and "/" Spacing))
(define-sexp-parser AND all
@@ -279,6 +288,7 @@ EndOfFile < !.
('Identifier (Identifier->defn value for-syntax))
('Expression (Expression->defn value for-syntax))
('Literal (Literal->defn value for-syntax))
+ ('NotInClass (NotInClass->defn value for-syntax))
('Class (Class->defn value for-syntax)))))
;; (Identifier "hello")
@@ -291,13 +301,35 @@ EndOfFile < !.
(define (Literal->defn lst for-syntax)
(apply string (map (lambda (x) (Char->defn x for-syntax)) (cdr lst))))
-;; TODO: empty Class can happen: `[]`, but what does it represent?
+;; (NotInClass ...)
+;; `-> (and ...)
+(define (NotInClass->defn lst for-syntax)
+ #`(and #,@(map (lambda (x) (NotInRange->defn x for-syntax))
+ (cdr lst))))
+
;; (Class ...)
;; `-> (or ...)
(define (Class->defn lst for-syntax)
#`(or #,@(map (lambda (x) (Range->defn x for-syntax))
(cdr lst))))
+;; NOTE: It's coming from NotInClass.
+;; For one character:
+;; (Range (Char "a"))
+;; `-> (not-in-range #\a #\a)
+;; Or for a range:
+;; (Range (Char "a") (Char "b"))
+;; `-> (not-in-range #\a #\b)
+(define (NotInRange->defn lst for-syntax)
+ (match lst
+ (('Range c)
+ (let ((ch (Char->defn c for-syntax)))
+ #`(not-in-range #,ch #,ch)))
+ (('Range range-beginning range-end)
+ #`(not-in-range
+ #,(Char->defn range-beginning for-syntax)
+ #,(Char->defn range-end for-syntax)))))
+
;; For one character:
;; (Range (Char "a"))
;; `-> "a"