52 lines
1.7 KiB
Racket
52 lines
1.7 KiB
Racket
#lang racket
|
|
(require syntax/readerr)
|
|
|
|
(provide read read-syntax)
|
|
|
|
(define (read in)
|
|
(syntax->datum (read-syntax #f in)))
|
|
|
|
(define (read-syntax src in)
|
|
(skip-whitespace in)
|
|
(read-arith src in))
|
|
|
|
(define (skip-whitespace in)
|
|
(regexp-match #px"^\\s*" in))
|
|
|
|
(define (read-arith src in)
|
|
(define-values (line col pos) (port-next-location in))
|
|
(define expr-match
|
|
(regexp-match
|
|
;; Match an operand followed by any number of
|
|
;; operator--operand sequences, and prohibit an
|
|
;; additional operator from following immediately:
|
|
#px"^([a-z]|[0-9]+)(?:[-+*/]([a-z]|[0-9]+))*(?![-+*/])"
|
|
in))
|
|
|
|
(define (to-syntax v delta span-str)
|
|
(datum->syntax #f v (make-srcloc delta span-str)))
|
|
(define (make-srcloc delta span-str)
|
|
(and line
|
|
(vector src line (+ col delta) (+ pos delta)
|
|
(string-length span-str))))
|
|
|
|
(define (parse-expr s delta)
|
|
(match (or (regexp-match #rx"^(.*?)([+-])(.*)$" s)
|
|
(regexp-match #rx"^(.*?)([*/])(.*)$" s))
|
|
[(list _ a-str op-str b-str)
|
|
(define a-len (string-length a-str))
|
|
(define a (parse-expr a-str delta))
|
|
(define b (parse-expr b-str (+ delta 1 a-len)))
|
|
(define op (to-syntax (string->symbol op-str)
|
|
(+ delta a-len) op-str))
|
|
(to-syntax (list op a b) delta s)]
|
|
[else (to-syntax (or (string->number s)
|
|
(string->symbol s))
|
|
delta s)]))
|
|
|
|
(unless expr-match
|
|
(raise-read-error "bad arithmetic syntax"
|
|
src line col pos
|
|
(and pos (- (file-position in) pos))))
|
|
(parse-expr (bytes->string/utf-8 (car expr-match)) 0))
|