(module parse (parse-line 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)))