#lang scheme
(require "../common.ss"
"../simple-parser.ss")
(define tree-parser (new-parser #:appender
(λ vals (remove* '(||) vals))))
(add-items
tree-parser
('start
["\\s+" '||]
["\\)" (λ(s)(sub-parse-return))]
["\\(" (λ(s)(sub-parse 'start)'||)]
[#t string->symbol]
)
)
(parse-text
tree-parser
"tree:(root (node1 (leaf1 leaf2)
leaf3) (node2
leaf4 (node3 leaf5) leaf6) leaf7)")
(newline)
(newline)
(define paren-parser (new-parser))
(list "(" #\() (define (parse-comment txt) txt)
#\(
(add-items
paren-parser
('start
["\\(" (λ(s)(sub-parse 'paren
(λ(text)(string-append "PAREN[" text "]")))s)]
[(txt "#\\(") (λ(s)(string-append "CHAR[" s "]"))]
[";.*" parse-comment]
["\"" (λ(s)(sub-parse 'string
(λ(text)(string-append "STRING[\"" text "]")))s)]
)
('paren ["\\)" (λ(s)(sub-parse-return s))]
["\\(" (λ(s)(sub-parse 'paren
(λ(text)(string-append "SPAREN[" text "]")))s)]
[";.*" parse-comment]
["\"" (λ(s)(sub-parse 'string
(λ(text)(string-append "P-STRING[" text "]")))s)]
[(map txt '("#\\(" "#\\)"))
(λ(s)(string-append "CHAR[" s "]"))]
)
('string ["[^\\\\\"]*" identity]
["\"" (λ(s)(sub-parse-return s))]
["\\\\." identity]
)
(#t ["λ" "***Lambda***"]
)
)
(define text1 (file->lines "paren-match-test.scm"))
(newline)
(newline)
(newline)
(display (apply parse-text paren-parser text1))