diff options
author | Noah Lavine <nlavine@haverford.edu> | 2011-01-30 15:59:52 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-01-16 10:11:29 +0100 |
commit | 2a88fe3046b569fb0fdc6b773fae69124c533e88 (patch) | |
tree | 83339c187d499dfb87fa061a4c2a1139b34b15b8 /module | |
parent | fe50d7ee1aa50a7d0b2154f84f4f012da2dad9fc (diff) | |
download | guile-2a88fe3046b569fb0fdc6b773fae69124c533e88.tar.gz |
peg: peg-sexp-compile datum->syntax refactor
* 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.
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/peg.scm | 64 |
1 files changed, 37 insertions, 27 deletions
diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm index 35ae7cef5..c373d5cc4 100644 --- a/module/ice-9/peg.scm +++ b/module/ice-9/peg.scm @@ -211,33 +211,43 @@ ;; Takes an arbitrary expressions and accumulation variable, then parses it. ;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all) (define (peg-sexp-compile for-syntax match accum) - (datum->syntax for-syntax - (cond - ((string? match) (cg-string for-syntax match (baf accum))) - ((symbol? match) ;; either peg-any or a nonterminal - (cond - ((eq? match 'peg-any) (cg-peg-any for-syntax (baf accum))) - ;; if match is any other symbol it's a nonterminal, so just return it - (#t match))) - ((or (not (list? match)) (null? match)) - ;; anything besides a string, symbol, or list is an error - (error-val `(peg-sexp-compile-error-1 ,match ,accum))) - - ((eq? (car match) 'range) ;; range of characters (e.g. [a-z]) - (cg-range for-syntax (cadr match) (caddr match) (baf accum))) - ((eq? (car match) 'ignore) ;; match but don't parse - (syntax->datum (peg-sexp-compile for-syntax (cadr match) 'none))) - ((eq? (car match) 'capture) ;; parse - (syntax->datum (peg-sexp-compile for-syntax (cadr match) 'body))) - ((eq? (car match) 'peg) ;; embedded PEG string - (syntax->datum (peg-string-compile for-syntax (cadr match) (baf accum)))) - ((eq? (car match) 'and) (cg-and for-syntax (cdr match) (baf accum))) - ((eq? (car match) 'or) (cg-or for-syntax (cdr match) (baf accum))) - ((eq? (car match) 'body) - (if (not (= (length match) 4)) - (error-val `(peg-sexp-compile-error-2 ,match ,accum)) - (apply cg-body for-syntax (cons (baf accum) (cdr match))))) - (#t (error-val `(peg-sexp-compile-error-3 ,match ,accum)))))) + (cond + ((string? match) (datum->syntax for-syntax + (cg-string for-syntax match (baf accum)))) + ((symbol? match) ;; either peg-any or a nonterminal + (cond + ((eq? match 'peg-any) (datum->syntax for-syntax + (cg-peg-any for-syntax (baf accum)))) + ;; if match is any other symbol it's a nonterminal, so just return it + (#t (datum->syntax for-syntax match)))) + ((or (not (list? match)) (null? match)) + ;; anything besides a string, symbol, or list is an error + (datum->syntax for-syntax + (error-val `(peg-sexp-compile-error-1 ,match ,accum)))) + + ((eq? (car match) 'range) ;; range of characters (e.g. [a-z]) + (datum->syntax for-syntax + (cg-range for-syntax (cadr match) (caddr match) (baf accum)))) + ((eq? (car match) 'ignore) ;; match but don't parse + (peg-sexp-compile for-syntax (cadr match) 'none)) + ((eq? (car match) 'capture) ;; parse + (peg-sexp-compile for-syntax (cadr match) 'body)) + ((eq? (car match) 'peg) ;; embedded PEG string + (peg-string-compile for-syntax (cadr match) (baf accum))) + ((eq? (car match) 'and) + (datum->syntax for-syntax + (cg-and for-syntax (cdr match) (baf 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. ;; If SYM is a list of one element, return (car SYM), else return SYM. |