58 lines
1.9 KiB
Scheme
58 lines
1.9 KiB
Scheme
;;; Parser module building on comparse.
|
|
|
|
(module parse (lift followed-by-consuming is-not parse-whitespace skip-whitespace parse-symbol parse-number parse-string followed-by-consuming separated-by parse-symbol-or-number-or-string completely-parse parse-statement parse-line)
|
|
(import scheme)
|
|
(import chicken.base)
|
|
(import srfi-13)
|
|
(import srfi-14)
|
|
(import util)
|
|
(import comparse)
|
|
|
|
(define +letter-char-set+
|
|
(string->char-set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVwXYZ"))
|
|
|
|
(define +symbol-char-set+
|
|
(char-set-union +letter-char-set+ (string->char-set "-0123456789")))
|
|
|
|
(define (lift fn parser)
|
|
(bind parser (compose result fn)))
|
|
|
|
(define (is-not x)
|
|
(satisfies (lambda (y)
|
|
(not (eqv? x y)))))
|
|
|
|
(define parse-whitespace
|
|
(one-or-more (is #\space)))
|
|
|
|
(define skip-whitespace
|
|
(skip (zero-or-more (is #\space))))
|
|
|
|
(define parse-symbol
|
|
(lift (compose string->symbol string-downcase list->string (applied append))
|
|
(sequence (lift list (in +letter-char-set+)) (zero-or-more (in +symbol-char-set+)))))
|
|
|
|
(define parse-number
|
|
(lift (compose string->number list->string) (one-or-more (in char-set:digit))))
|
|
|
|
(define parse-string
|
|
(lift list->string (enclosed-by (is #\") (one-or-more (is-not #\")) (is #\"))))
|
|
|
|
(define (followed-by-consuming parser separator)
|
|
(sequence* ((value parser) (_ separator))
|
|
(result value)))
|
|
|
|
(define (separated-by separator parser)
|
|
(one-or-more (any-of (followed-by-consuming parser separator) parser)))
|
|
|
|
(define parse-symbol-or-number-or-string
|
|
(any-of parse-number parse-symbol parse-string))
|
|
|
|
(define (completely-parse parser)
|
|
(followed-by parser end-of-input))
|
|
|
|
(define parse-statement
|
|
(all-of skip-whitespace (separated-by parse-whitespace parse-symbol-or-number-or-string)))
|
|
|
|
(define (parse-line line)
|
|
(parse (completely-parse parse-statement) line)))
|