1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00

Rename in peg.scm

* module/ice-9/peg.scm: rename peg-parse-* functions to avoid confusion
    with what PEGs do.
This commit is contained in:
Noah Lavine 2011-03-05 16:23:05 -05:00 committed by Andy Wingo
parent bff3ccd957
commit 86849e2c19

View file

@ -305,7 +305,7 @@ RB < ']'
((or (not (list? lst)) (null? lst)) ((or (not (list? lst)) (null? lst))
lst) lst)
((eq? (car lst) 'peg-grammar) ((eq? (car lst) 'peg-grammar)
(cons 'begin (map (lambda (x) (peg-parse-nonterm x)) (cons 'begin (map (lambda (x) (peg-nonterm->defn x))
(context-flatten (lambda (lst) (<= (depth lst) 2)) (context-flatten (lambda (lst) (<= (depth lst) 2))
(cdr lst)))))))))) (cdr lst))))))))))
@ -319,7 +319,7 @@ RB < ']'
(define define-grammar-f peg-parser) (define define-grammar-f peg-parser)
;; Parse a nonterminal and pattern listed in LST. ;; Parse a nonterminal and pattern listed in LST.
(define (peg-parse-nonterm lst) (define (peg-nonterm->defn lst)
(let ((nonterm (car lst)) (let ((nonterm (car lst))
(grabber (cadr lst)) (grabber (cadr lst))
(pattern (caddr lst))) (pattern (caddr lst)))
@ -328,23 +328,23 @@ RB < ']'
((string=? grabber "<--") 'all) ((string=? grabber "<--") 'all)
((string=? grabber "<-") 'body) ((string=? grabber "<-") 'body)
(else 'none)) (else 'none))
,(compressor (peg-parse-pattern pattern))))) ,(compressor (peg-pattern->defn pattern)))))
;; Parse a pattern. ;; Parse a pattern.
(define (peg-parse-pattern lst) (define (peg-pattern->defn lst)
(cons 'or (map peg-parse-alternative (cons 'or (map peg-alternative->defn
(context-flatten (lambda (x) (eq? (car x) 'peg-alternative)) (context-flatten (lambda (x) (eq? (car x) 'peg-alternative))
(cdr lst))))) (cdr lst)))))
;; Parse an alternative. ;; Parse an alternative.
(define (peg-parse-alternative lst) (define (peg-alternative->defn lst)
(cons 'and (map peg-parse-body (cons 'and (map peg-body->defn
(context-flatten (lambda (x) (or (string? (car x)) (context-flatten (lambda (x) (or (string? (car x))
(eq? (car x) 'peg-suffix))) (eq? (car x) 'peg-suffix)))
(cdr lst))))) (cdr lst)))))
;; Parse a body. ;; Parse a body.
(define (peg-parse-body lst) (define (peg-body->defn lst)
(let ((suffix '()) (let ((suffix '())
(front 'lit)) (front 'lit))
(cond (cond
@ -354,41 +354,41 @@ RB < ']'
(begin (set! front (string->symbol (car lst))) (begin (set! front (string->symbol (car lst)))
(set! suffix (cadr lst)))) (set! suffix (cadr lst))))
(else `(peg-parse-body-fail ,lst))) (else `(peg-parse-body-fail ,lst)))
`(body ,front ,@(peg-parse-suffix suffix)))) `(body ,front ,@(peg-suffix->defn suffix))))
;; Parse a suffix. ;; Parse a suffix.
(define (peg-parse-suffix lst) (define (peg-suffix->defn lst)
(list (peg-parse-primary (cadr lst)) (list (peg-primary->defn (cadr lst))
(if (null? (cddr lst)) (if (null? (cddr lst))
1 1
(string->symbol (caddr lst))))) (string->symbol (caddr lst)))))
;; Parse a primary. ;; Parse a primary.
(define (peg-parse-primary lst) (define (peg-primary->defn lst)
(let ((el (cadr lst))) (let ((el (cadr lst)))
(cond (cond
((list? el) ((list? el)
(cond (cond
((eq? (car el) 'peg-literal) ((eq? (car el) 'peg-literal)
(peg-parse-literal el)) (peg-literal->defn el))
((eq? (car el) 'peg-charclass) ((eq? (car el) 'peg-charclass)
(peg-parse-charclass el)) (peg-charclass->defn el))
((eq? (car el) 'peg-nonterminal) ((eq? (car el) 'peg-nonterminal)
(string->symbol (cadr el))))) (string->symbol (cadr el)))))
((string? el) ((string? el)
(cond (cond
((equal? el "(") ((equal? el "(")
(peg-parse-pattern (caddr lst))) (peg-pattern->defn (caddr lst)))
((equal? el ".") ((equal? el ".")
'peg-any) 'peg-any)
(else `(peg-parse-any unknown-string ,lst)))) (else `(peg-parse-any unknown-string ,lst))))
(else `(peg-parse-any unknown-el ,lst))))) (else `(peg-parse-any unknown-el ,lst)))))
;; Parses a literal. ;; Parses a literal.
(define (peg-parse-literal lst) (trim-1chars (cadr lst))) (define (peg-literal->defn lst) (trim-1chars (cadr lst)))
;; Parses a charclass. ;; Parses a charclass.
(define (peg-parse-charclass lst) (define (peg-charclass->defn lst)
(cons 'or (cons 'or
(map (map
(lambda (cc) (lambda (cc)
@ -423,7 +423,7 @@ RB < ']'
(datum->syntax (datum->syntax
str-stx str-stx
(compressor (compressor
(peg-parse-pattern (peg-pattern->defn
(peg:tree (peg-parse peg-pattern (syntax->datum str-stx)))))) (peg:tree (peg-parse peg-pattern (syntax->datum str-stx))))))
accum)) accum))