diff options
author | Ekaitz Zarraga <ekaitz@elenq.tech> | 2024-10-11 14:24:30 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-12-09 18:15:01 +0100 |
commit | 25504ba216a39247eb2dda168a45ad03c447b018 (patch) | |
tree | 50770606f443b1ccfadeb055c63d07e1d6271e40 /module | |
parent | ff11753df146d6a170521c898a8c784483c5c743 (diff) | |
download | guile-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.scm | 22 | ||||
-rw-r--r-- | module/ice-9/peg/string-peg.scm | 38 |
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" |