mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-02 10:16:19 +02:00
Code Activity

peg: change some instances of "match" to "pat"

Browse source 
* module/ice-9/peg.scm (cg-string): Rename "match" to "pat".
  (peg-sexp-compile, cg-body-test, cg-body, define-nonterm): Likewise.
This commit is contained in:
Andy Wingo 2011-02-18 11:31:18 +01:00
parent 63a1336de7
commit c5b85eceba
1 changed files with 38 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

76
module/ice-9/peg.scm
View file

@ -122,16 +122,16 @@ return EXP."
;; Generates code that matches a particular string. ;; Generates code that matches a particular string.
;; E.g.: (cg-string syntax "abc" 'body) ;; E.g.: (cg-string syntax "abc" 'body)
(define (cg-string for-syntax match accum) (define (cg-string for-syntax pat accum)
(let ((mlen (string-length match))) (let ((plen (string-length pat)))
#`(lambda (str len pos) #`(lambda (str len pos)
(let ((end (+ pos #,mlen))) (let ((end (+ pos #,plen)))
(and (<= end len) (and (<= end len)
(string= str #,match pos end) (string= str #,pat pos end)
#,(case accum #,(case accum
((all) #`(list end (list 'cg-string #,match))) ((all) #`(list end (list 'cg-string #,pat)))
((name) #`(list end 'cg-string)) ((name) #`(list end 'cg-string))
((body) #`(list end #,match)) ((body) #`(list end #,pat))
((none) #`(list end '())) ((none) #`(list end '()))
(else (error "bad accum" accum)))))))) (else (error "bad accum" accum))))))))
@ -183,38 +183,38 @@ return EXP."
;; Takes an arbitrary expressions and accumulation variable, then parses it. ;; Takes an arbitrary expressions and accumulation variable, then parses it.
;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all) ;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all)
(define (peg-sexp-compile for-syntax match accum) (define (peg-sexp-compile for-syntax pat accum)
(cond (cond
((string? match) (cg-string for-syntax match (baf accum))) ((string? pat) (cg-string for-syntax pat (baf accum)))
((symbol? match) ;; either peg-any or a nonterminal ((symbol? pat) ;; either peg-any or a nonterminal
(cond (cond
((eq? match 'peg-any) (cg-peg-any for-syntax (baf accum))) ((eq? pat 'peg-any) (cg-peg-any for-syntax (baf accum)))
;; if match is any other symbol it's a nonterminal, so just return it ;; if pat is any other symbol it's a nonterminal, so just return it
(else (datum->syntax for-syntax match)))) (else (datum->syntax for-syntax pat))))
((or (not (list? match)) (null? match)) ((or (not (list? pat)) (null? pat))
;; anything besides a string, symbol, or list is an error ;; anything besides a string, symbol, or list is an error
(datum->syntax for-syntax (datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-1 ,match ,accum)))) (error-val `(peg-sexp-compile-error-1 ,pat ,accum))))
((eq? (car match) 'range) ;; range of characters (e.g. [a-z]) ((eq? (car pat) 'range) ;; range of characters (e.g. [a-z])
(cg-range for-syntax (cadr match) (caddr match) (baf accum))) (cg-range for-syntax (cadr pat) (caddr pat) (baf accum)))
((eq? (car match) 'ignore) ;; match but don't parse ((eq? (car pat) 'ignore) ;; match but don't parse
(peg-sexp-compile for-syntax (cadr match) 'none)) (peg-sexp-compile for-syntax (cadr pat) 'none))
((eq? (car match) 'capture) ;; parse ((eq? (car pat) 'capture) ;; parse
(peg-sexp-compile for-syntax (cadr match) 'body)) (peg-sexp-compile for-syntax (cadr pat) 'body))
((eq? (car match) 'peg) ;; embedded PEG string ((eq? (car pat) 'peg) ;; embedded PEG string
(peg-string-compile for-syntax (cadr match) (baf accum))) (peg-string-compile for-syntax (cadr pat) (baf accum)))
((eq? (car match) 'and) ((eq? (car pat) 'and)
(cg-and for-syntax (cdr match) (baf accum))) (cg-and for-syntax (cdr pat) (baf accum)))
((eq? (car match) 'or) ((eq? (car pat) 'or)
(cg-or for-syntax (cdr match) (baf accum))) (cg-or for-syntax (cdr pat) (baf accum)))
((eq? (car match) 'body) ((eq? (car pat) 'body)
(if (not (= (length match) 4)) (if (not (= (length pat) 4))
(datum->syntax for-syntax (datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-2 ,match ,accum))) (error-val `(peg-sexp-compile-error-2 ,pat ,accum)))
(datum->syntax for-syntax (datum->syntax for-syntax
(apply cg-body for-syntax (cons (baf accum) (cdr match)))))) (apply cg-body for-syntax (cons (baf accum) (cdr pat))))))
(else (datum->syntax for-syntax (else (datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-3 ,match ,accum)))))) (error-val `(peg-sexp-compile-error-3 ,pat ,accum))))))
;; Top-level function builder for AND. Reduces to a call to CG-AND-INT. ;; Top-level function builder for AND. Reduces to a call to CG-AND-INT.
(define (cg-and for-syntax arglst accum) (define (cg-and for-syntax arglst accum)
@ -252,10 +252,10 @@ return EXP."
#,(cggr for-syntax accum 'cg-or #`(cadr res) #`(car res)) #,(cggr for-syntax accum 'cg-or #`(cadr res) #`(car res))
#,(cg-or-int for-syntax (cdr arglst) accum str strlen at body)))))) #,(cg-or-int for-syntax (cdr arglst) accum str strlen at body))))))
;; Returns a block of code that tries to match MATCH, and on success updates AT ;; Returns a block of code that tries to match PAT, and on success updates AT
;; and BODY, return #f on failure and #t on success. ;; and BODY, return #f on failure and #t on success.
(define (cg-body-test for-syntax match accum str strlen at body) (define (cg-body-test for-syntax pat accum str strlen at body)
(let ((mf (peg-sexp-compile for-syntax match accum))) (let ((mf (peg-sexp-compile for-syntax pat accum)))
#`(let ((at2-body2 (#,mf #,str #,strlen #,at))) #`(let ((at2-body2 (#,mf #,str #,strlen #,at)))
(if (or (not at2-body2) (= #,at (car at2-body2))) (if (or (not at2-body2) (= #,at (car at2-body2)))
#f #f
@ -300,13 +300,13 @@ return EXP."
(else `(cg-body-success-error ,num)))) (else `(cg-body-success-error ,num))))
;; Returns a function that parses a BODY element. ;; Returns a function that parses a BODY element.
(define (cg-body for-syntax accum type match num) (define (cg-body for-syntax accum type pat num)
(let (; this doesn't work with regular syntax, and I'd really (let (; this doesn't work with regular syntax, and I'd really
; like to know why. ; like to know why.
(at2 (datum->syntax for-syntax (gensym)))) (at2 (datum->syntax for-syntax (gensym))))
#`(lambda (str strlen at) #`(lambda (str strlen at)
(let ((#,at2 at) (count 0) (body '())) (let ((#,at2 at) (count 0) (body '()))
(while (and #,(cg-body-test for-syntax match accum (while (and #,(cg-body-test for-syntax pat accum
#'str #'strlen at2 #'body) #'str #'strlen at2 #'body)
(set! count (+ count 1)) (set! count (+ count 1))
#,(cg-body-more for-syntax num #'count))) #,(cg-body-more for-syntax num #'count)))
@ -354,8 +354,8 @@ return EXP."
(define-syntax define-nonterm (define-syntax define-nonterm
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ sym accum match) ((_ sym accum pat)
(let ((matchf (peg-sexp-compile x (syntax->datum #'match) (let ((matchf (peg-sexp-compile x (syntax->datum #'pat)
(syntax->datum #'accum))) (syntax->datum #'accum)))
(accumsym (syntax->datum #'accum)) (accumsym (syntax->datum #'accum))
(c (datum->syntax x (gensym))));; the cache (c (datum->syntax x (gensym))));; the cache