47fa3f29ec
~> only works within a form. If not used in a form, it is read a string, and the macro won't be found.
91 lines
3.0 KiB
Racket
91 lines
3.0 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)))
|
|
(define (finish-line words delta)
|
|
(cond
|
|
[(null? words) eof]
|
|
[(and (= 1 (length words))
|
|
(syntax->list (car words)))
|
|
(list->rash-syntax (car words) delta)]
|
|
[else (list->rash-syntax (reverse words) delta)]))
|
|
|
|
(let loop ([words '()]
|
|
[delta 0])
|
|
(define-values (line col pos) (port-next-location in))
|
|
(define peeked-char (peek-char in))
|
|
(cond
|
|
[(eof-object? peeked-char)
|
|
(read-char in)
|
|
(finish-line words delta)]
|
|
[(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))
|
|
(finish-line words delta)))]
|
|
[(regexp-try-match #px"^[ \t]+" in) =>
|
|
(λ (r)
|
|
(define m (bytes->string/utf-8 (car r)))
|
|
(loop words (+ delta (string-length m))))]
|
|
[(char=? #\( peeked-char)
|
|
(define lst (read in))
|
|
(define stx (datum->syntax #f lst))
|
|
(loop (cons stx words) delta)]
|
|
[(char=? #\" peeked-char)
|
|
(let* ([str (read in)]
|
|
[len (+ 2 (string-length str))]
|
|
[stx (datum->syntax #f str (vector src line col pos len))])
|
|
(loop (cons stx words) (+ delta len)))]
|
|
[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\""))))
|
|
|
|
(test-case
|
|
"Read an s-expression"
|
|
(check-equal? '(~> (echo) (wc)) (rash-read (2port "(~> (echo) (wc))"))
|
|
"One s-exp ending in eof")
|
|
(check-equal? '(~> (echo) (wc)) (rash-read (2port "(~> (echo) (wc))\n"))
|
|
"One s-exp ending in newline"))
|
|
|
|
(test-case
|
|
"Read a sub s-expression"
|
|
(check equal? '("~>" (echo) (wc)) (rash-read (2port "~> (echo) (wc)")))))
|