71 lines
2.6 KiB
Racket
71 lines
2.6 KiB
Racket
|
#lang racket
|
||
|
|
(require rackunit)
|
||
|
|
(require racket/port)
|
||
|
|
|
||
|
|
;; The only visible export of this module will be parse-expr.
|
||
|
|
(provide parse-expr)
|
||
|
|
|
||
|
|
#|
|
||
|
|
(define code "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.---.+++++++..+++.---------
|
||
|
|
-+++------------------------------------------------------------------------++++++++++++++++++++++++++++++++.
|
||
|
|
--------------------------------,.[,.]!Input")
|
||
|
|
|
||
|
|
(cond [(regexp-match-positions "!" code) (substring code (cdar (regexp-match-positions "!" code)))])
|
||
|
|
|
||
|
|
(cond [(regexp-match-positions "!" code) (open-input-bytes (string->bytes/utf-8 (substring code (cdar (regexp-match-positions "!" code)))))])
|
||
|
|
|#
|
||
|
|
|
||
|
|
;; parse-expr: any input-port -> (U syntax eof)
|
||
|
|
;; Either produces a syntax object or the eof object.
|
||
|
|
(define (parse-expr src in)
|
||
|
|
|
||
|
|
(define code (file->string src));file to string
|
||
|
|
(cond [(regexp-match-positions "!" code) (current-input-port (open-input-bytes (string->bytes/utf-8 (substring code (cdar (regexp-match-positions "!" code))))))])
|
||
|
|
|
||
|
|
(define-values (line column position) (port-next-location in))
|
||
|
|
(define next-char (read-char in))
|
||
|
|
|
||
|
|
;; decorate/span: s-expression number -> syntax
|
||
|
|
;; Wrap the s-expression with source location.
|
||
|
|
(define (decorate sexp span)
|
||
|
|
(datum->syntax #f sexp (list src line column position span)))
|
||
|
|
|
||
|
|
(cond
|
||
|
|
[(eof-object? next-char) eof]
|
||
|
|
[else
|
||
|
|
(case next-char
|
||
|
|
[(#\<) (decorate '(less-than) 1)]
|
||
|
|
[(#\>) (decorate '(greater-than) 1)]
|
||
|
|
[(#\+) (decorate '(plus) 1)]
|
||
|
|
[(#\-) (decorate '(minus) 1)]
|
||
|
|
[(#\,) (decorate '(comma) 1)]
|
||
|
|
[(#\.) (decorate '(period) 1)]
|
||
|
|
[(#\:) (decorate '(colon) 1)]
|
||
|
|
[(#\[)
|
||
|
|
;; The slightly messy case is bracket. We keep reading
|
||
|
|
;; a list of exprs, and then construct a wrapping bracket
|
||
|
|
;; around the whole thing.
|
||
|
|
(define elements (parse-exprs src in))
|
||
|
|
(define-values (l c tail-position)
|
||
|
|
(port-next-location in))
|
||
|
|
(decorate `(brackets ,@elements)
|
||
|
|
(- tail-position position))]
|
||
|
|
[else
|
||
|
|
(parse-expr src in)])]))
|
||
|
|
|
||
|
|
;; parse-exprs: input-port -> (listof syntax)
|
||
|
|
;; Parse a list of expressions.
|
||
|
|
(define (parse-exprs source-name in)
|
||
|
|
(define peeked-char (peek-char in))
|
||
|
|
(cond
|
||
|
|
[(eof-object? peeked-char)
|
||
|
|
(error 'parse-exprs "Expected ], but read eof")]
|
||
|
|
[(char=? peeked-char #\])
|
||
|
|
(read-char in)
|
||
|
|
empty]
|
||
|
|
[(member peeked-char (list #\< #\> #\+ #\- #\, #\. #\[ #\:))
|
||
|
|
(cons (parse-expr source-name in)
|
||
|
|
(parse-exprs source-name in))]
|
||
|
|
[else
|
||
|
|
(read-char in)
|
||
|
|
(parse-exprs source-name in)]))
|