mirror of
https://github.com/kanaka/mal.git
synced 2024-09-21 10:37:58 +03:00
4aa0ebdf47
Add a step1 test to make sure that implementations are properly throwing an error on unclosed strings. Fix 47 implementations and update the guide to note the correct behavior.
84 lines
3.0 KiB
Racket
84 lines
3.0 KiB
Racket
#lang racket
|
|
|
|
(provide read_str)
|
|
|
|
(require "types.rkt")
|
|
|
|
(define Reader%
|
|
(class object%
|
|
(init tokens)
|
|
(super-new)
|
|
(define toks tokens)
|
|
(define position 0)
|
|
(define/public (next)
|
|
(cond [(>= position (length toks)) null]
|
|
[else (begin
|
|
(set! position (+ 1 position))
|
|
(list-ref toks (- position 1)))]))
|
|
(define/public (peek)
|
|
(cond [(>= position (length toks)) null]
|
|
[else (list-ref toks position )]))))
|
|
|
|
|
|
(define (tokenize str)
|
|
(filter-not (lambda (s) (or (equal? s "") (equal? (substring s 0 1) ";")))
|
|
(regexp-match* #px"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"?|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)"
|
|
str #:match-select cadr)))
|
|
|
|
(define (read_atom rdr)
|
|
(let ([token (send rdr next)])
|
|
(cond [(regexp-match #px"^-?[0-9]+$" token)
|
|
(string->number token)]
|
|
[(regexp-match #px"^-?[0-9][0-9.]*$" token)
|
|
(string->number token)]
|
|
[(regexp-match #px"^\".*\"$" token)
|
|
(with-input-from-string token read)]
|
|
[(regexp-match #px"^\".*$" token)
|
|
(raise "expected '\"', got EOF")]
|
|
[(regexp-match #px"^:" token) (_keyword (substring token 1))]
|
|
[(equal? "nil" token) nil]
|
|
[(equal? "true" token) #t]
|
|
[(equal? "false" token) #f]
|
|
[else (string->symbol token)])))
|
|
|
|
(define (read_list_entries rdr end)
|
|
(let ([tok (send rdr peek)])
|
|
(cond
|
|
[(eq? tok '()) (raise (string-append "expected '" end "', got EOF"))]
|
|
[(equal? end tok) '()]
|
|
[else
|
|
(cons (read_form rdr) (read_list_entries rdr end))])))
|
|
|
|
(define (read_list rdr start end)
|
|
(let ([token (send rdr next)])
|
|
(if (equal? start token)
|
|
(let ([lst (read_list_entries rdr end)])
|
|
(send rdr next)
|
|
lst)
|
|
(raise (string-append "expected '" start "', got EOF")))))
|
|
|
|
(define (read_form rdr)
|
|
(let ([token (send rdr peek)])
|
|
(if (null? token)
|
|
(raise (make-blank-exn "blank line" (current-continuation-marks)))
|
|
(cond
|
|
[(equal? "'" token) (send rdr next) (list 'quote (read_form rdr))]
|
|
[(equal? "`" token) (send rdr next) (list 'quasiquote (read_form rdr))]
|
|
[(equal? "~" token) (send rdr next) (list 'unquote (read_form rdr))]
|
|
[(equal? "~@" token) (send rdr next) (list 'splice-unquote (read_form rdr))]
|
|
[(equal? "^" token) (send rdr next)
|
|
(let ([meta (read_form rdr)])
|
|
(list 'with-meta (read_form rdr) meta))]
|
|
[(equal? "@" token) (send rdr next) (list 'deref (read_form rdr))]
|
|
|
|
[(equal? ")" token) (raise "unexpected ')'")]
|
|
[(equal? "(" token) (read_list rdr "(" ")")]
|
|
[(equal? "]" token) (raise "unexpected ']'")]
|
|
[(equal? "[" token) (list->vector (read_list rdr "[" "]"))]
|
|
[(equal? "}" token) (raise "unexpected '}'")]
|
|
[(equal? "{" token) (apply hash (read_list rdr "{" "}"))]
|
|
[else (read_atom rdr)]))))
|
|
|
|
(define (read_str str)
|
|
(read_form (new Reader% [tokens (tokenize str)])))
|