af9dfb7876
When proc-expression is a string call start instead with proc-expression as the first argument.
72 lines
2.3 KiB
Racket
72 lines
2.3 KiB
Racket
#lang racket/base
|
|
|
|
(require syntax/readerr
|
|
(prefix-in rash: "language.rkt"))
|
|
|
|
(provide (rename-out [rash-read read]
|
|
[rash-read-syntax read-syntax]))
|
|
|
|
(define (rash-read in)
|
|
(syntax->datum (rash-read-syntax #f in)))
|
|
|
|
(define (rash-read-syntax src in)
|
|
(define-values (start-line start-col start-pos) (port-next-location in))
|
|
(define (list->rash-syntax l span)
|
|
(datum->syntax #f
|
|
l
|
|
(vector src start-line start-col start-pos span)))
|
|
|
|
(let loop ([words '()]
|
|
[delta 0])
|
|
(define-values (line col pos) (port-next-location in))
|
|
(cond
|
|
[(regexp-try-match #px"^[[:alnum:]]+" in) =>
|
|
(λ (r)
|
|
(define m (bytes->string/utf-8 (car r)))
|
|
(define len (string-length m))
|
|
(define word (datum->syntax #f m (vector src line col pos len)))
|
|
(loop (cons word words) (+ delta len)))]
|
|
[(regexp-try-match #px"^\n" in) => (λ (m)
|
|
(if (null? words)
|
|
(loop words (add1 delta))
|
|
(list->rash-syntax
|
|
(reverse words)
|
|
delta)))]
|
|
[(regexp-try-match #px"^[ \t]+" in) =>
|
|
(λ (r)
|
|
(define m (bytes->string/utf-8 (car r)))
|
|
(loop words (+ delta (string-length m))))]
|
|
[(regexp-match-peek #px"^\"" in)
|
|
(let* ([str (read in)]
|
|
[len (+ 2 (string-length str))]
|
|
[stx (datum->syntax #f str (vector src line col pos len))])
|
|
(loop (cons str words) (+ delta len)))]
|
|
[(eof-object? (peek-char in))
|
|
(read-char in)
|
|
(if (null? words)
|
|
eof
|
|
(list->rash-syntax (reverse words) delta))]
|
|
[else (raise-read-error
|
|
(string-append "Unknown character " (read-char in))
|
|
src line col pos 1)])))
|
|
|
|
(module+ test
|
|
(require rackunit)
|
|
|
|
(define (2port str)
|
|
(open-input-string str))
|
|
|
|
(test-case
|
|
"Read alphanumeric words with EOF"
|
|
(check equal? '("echo" "hello1") (rash-read (2port "echo hello1"))))
|
|
|
|
(test-case
|
|
"Read string with newline"
|
|
(check equal? '("echo") (rash-read (2port "echo\n"))))
|
|
|
|
(test-case
|
|
"Read string"
|
|
(check equal?
|
|
'("echo" "hello world")
|
|
(rash-read (2port "echo \"hello world\"")))))
|