(define (parser input offset) (define (parse_program) (lambda () (seq (many (lambda (input offset) (((parse_ws)) input offset))) (many1 (lambda (input offset) (((parse_rule)) input offset))) (make-action "\n`(define (parser input offset) \n\t,@(second data)\n\t(((parse_program)) input offset)) ")))) (define (parse_rule) (lambda () (seq (lambda (input offset) (((parse_id)) input offset)) (many (lambda (input offset) (((parse_ws)) input offset))) (match-string "<-") (many (lambda (input offset) (((parse_ws)) input offset))) (lambda (input offset) (((parse_ordered-expr-list)) input offset)) (many (lambda (input offset) (((parse_ws_or_nl)) input offset))) (make-action " `(define (,(make-name (first data))) (lambda () ,(fifth data))) ")))) (define (parse_ordered-expr-list) (lambda () (either (seq (lambda (input offset) (((parse_expr-list)) input offset)) (many (lambda (input offset) (((parse_ws)) input offset))) (match-string "/") (many (lambda (input offset) (((parse_ws)) input offset))) (lambda (input offset) (((parse_ordered-expr-list)) input offset)) (make-action " \n(let ((tail (fifth data)))\n\t(if (eq? (first tail) 'either)\n\t    `(either ,(first data) ,@(cdr tail))\n\t    `(either ,(first data) ,(fifth data))))\n")) (seq (lambda (input offset) (((parse_expr-list)) input offset)) (make-action " (first data) "))))) (define (parse_expr-list) (lambda () (seq (lambda (input offset) (((parse_expr)) input offset)) (many (seq (many1 (lambda (input offset) (((parse_ws)) input offset))) (lambda (input offset) (((parse_expr-list)) input offset)))) (make-action "\n(if (or (null? (second data))\n\t(and (not (pair? (second data)))\n\t     (string=? (second data) \"\")))\n    (first data)\n    (let ((tail (second (first (second data)))))\n      (if (eq? (first tail) 'seq)\n\t  `(seq ,(first data) ,@(cdr tail))\n\t  `(seq ,(first data) ,tail))))\n")))) (define (parse_expr) (lambda () (either (seq (lambda (input offset) (((parse_simple-expr)) input offset)) (match-string "*") (make-action " `(many ,(first data)) ")) (seq (lambda (input offset) (((parse_simple-expr)) input offset)) (match-string "+") (make-action " `(many1 ,(first data)) ")) (seq (lambda (input offset) (((parse_simple-expr)) input offset)) (match-string "?")) (seq (lambda (input offset) (((parse_simple-expr)) input offset)) (make-action " (first data) "))))) (define (parse_simple-expr) (lambda () (either (seq (lambda (input offset) (((parse_string)) input offset)) (make-action " (first data) ")) (lambda (input offset) (((parse_action)) input offset)) (seq (lambda (input offset) (((parse_id)) input offset)) (make-action " (make-scheme-call-rule-closure (make-name (first data))) ")) (seq (lambda (input offset) (((parse_bracketed-rule)) input offset)) (make-action " (first data) ")) (match-string "!.") (seq (match-string "!") (lambda (input offset) (((parse_expr)) input offset)) (make-action " `(negate ,(second data)) ")) (seq (lambda (input offset) (((parse_character-class)) input offset)) (make-action " (first data) ")) (seq (match-string ".") (make-action " `(match-any-char 'dummy) "))))) (define (parse_bracketed-rule) (lambda () (either (match-string "()") (seq (match-string "(") (many (lambda (input offset) (((parse_ws)) input offset))) (lambda (input offset) (((parse_ordered-expr-list)) input offset)) (many (lambda (input offset) (((parse_ws)) input offset))) (match-string ")") (make-action " (third data) "))))) (define (parse_id) (lambda () (seq (many1 (match-char (quote (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\- #\_)))) (make-action " (char-list-to-string (first data)) ")))) (define (parse_character-class) (lambda () (seq (match-string "[") (many1 (seq (lambda (input offset) (((parse_not_right_bracket)) input offset)) (match-any-char (quote dummy)))) (match-string "]") (make-action " `(match-char ',(fix-escapes (zip-second (second data)))) ")))) (define (parse_string) (lambda () (seq (match-char (quote (#\"))) (many (seq (negate (match-char (quote (#\")))) (match-any-char (quote dummy)))) (match-char (quote (#\"))) (make-action " `(match-string ,(char-list-to-string (zip-second (second data)))) ")))) (define (parse_action) (lambda () (seq (match-char (quote (#\{))) (many (seq (negate (match-char (quote (#\})))) (match-any-char (quote dummy)))) (match-char (quote (#\}))) (make-action " `(make-action ,(char-list-to-string (fix-escapes (zip-second (second data))))) ")))) (define (parse_not_right_bracket) (lambda () (negate (match-string "]")))) (define (parse_ws) (lambda () (match-char (quote (#\space #\tab))))) (define (parse_nl) (lambda () (match-char (quote (#\newline))))) (define (parse_ws_or_nl) (lambda () (either (lambda (input offset) (((parse_ws)) input offset)) (lambda (input offset) (((parse_nl)) input offset))))) (((parse_program)) input offset))