mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

peg: peg-sexp-compile datum->syntax refactor

Browse source 
* module/ice-9/peg.scm (peg-sexp-compile): Push datum->syntax call
  through cond expression in peg-sexp-compile. This is a preliminary
  move so that I can convert the code-generating functions into
  syntax-generating functions one by one.
This commit is contained in:
Noah Lavine 2011-01-30 15:59:52 -05:00 • committed by Andy Wingo
parent fe50d7ee1a
commit 2a88fe3046
1 changed files with 37 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -211,33 +211,43 @@
;; 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 match accum)
(datum->syntax for-syntax (cond
(cond ((string? match) (datum->syntax for-syntax
((string? match) (cg-string for-syntax match (baf accum))) (cg-string for-syntax match (baf accum))))
((symbol? match) ;; either peg-any or a nonterminal ((symbol? match) ;; either peg-any or a nonterminal
(cond (cond
((eq? match 'peg-any) (cg-peg-any for-syntax (baf accum))) ((eq? match 'peg-any) (datum->syntax for-syntax
;; if match is any other symbol it's a nonterminal, so just return it (cg-peg-any for-syntax (baf accum))))
(#t match))) ;; if match is any other symbol it's a nonterminal, so just return it
((or (not (list? match)) (null? match)) (#t (datum->syntax for-syntax match))))
;; anything besides a string, symbol, or list is an error ((or (not (list? match)) (null? match))
(error-val `(peg-sexp-compile-error-1 ,match ,accum))) ;; anything besides a string, symbol, or list is an error
(datum->syntax for-syntax
((eq? (car match) 'range) ;; range of characters (e.g. [a-z]) (error-val `(peg-sexp-compile-error-1 ,match ,accum))))
(cg-range for-syntax (cadr match) (caddr match) (baf accum)))
((eq? (car match) 'ignore) ;; match but don't parse ((eq? (car match) 'range) ;; range of characters (e.g. [a-z])
(syntax->datum (peg-sexp-compile for-syntax (cadr match) 'none))) (datum->syntax for-syntax
((eq? (car match) 'capture) ;; parse (cg-range for-syntax (cadr match) (caddr match) (baf accum))))
(syntax->datum (peg-sexp-compile for-syntax (cadr match) 'body))) ((eq? (car match) 'ignore) ;; match but don't parse
((eq? (car match) 'peg) ;; embedded PEG string (peg-sexp-compile for-syntax (cadr match) 'none))
(syntax->datum (peg-string-compile for-syntax (cadr match) (baf accum)))) ((eq? (car match) 'capture) ;; parse
((eq? (car match) 'and) (cg-and for-syntax (cdr match) (baf accum))) (peg-sexp-compile for-syntax (cadr match) 'body))
((eq? (car match) 'or) (cg-or for-syntax (cdr match) (baf accum))) ((eq? (car match) 'peg) ;; embedded PEG string
((eq? (car match) 'body) (peg-string-compile for-syntax (cadr match) (baf accum)))
(if (not (= (length match) 4)) ((eq? (car match) 'and)
(error-val `(peg-sexp-compile-error-2 ,match ,accum)) (datum->syntax for-syntax
(apply cg-body for-syntax (cons (baf accum) (cdr match))))) (cg-and for-syntax (cdr match) (baf accum))))
(#t (error-val `(peg-sexp-compile-error-3 ,match ,accum)))))) ((eq? (car match) 'or)
(datum->syntax for-syntax
(cg-or for-syntax (cdr match) (baf accum))))
((eq? (car match) 'body)
(if (not (= (length match) 4))
(datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-2 ,match ,accum)))
(datum->syntax for-syntax
(apply cg-body for-syntax (cons (baf accum) (cdr match))))))
(#t (datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-3 ,match ,accum))))))
;;;;; Convenience macros for making sure things come out in a readable form. ;;;;; Convenience macros for making sure things come out in a readable form.
;; If SYM is a list of one element, return (car SYM), else return SYM. ;; If SYM is a list of one element, return (car SYM), else return SYM.