beautiful-racket/beautiful-racket-demo/jsonic-2/tokenizer.rkt

#lang br/quicklang
(require brag/support)

(module+ test
  (require rackunit))

(define (token? x)
  (or (eof-object? x) (string? x) (token-struct? x)))

(module+ test
  (check-true (token? eof))
  (check-true (token? "a string"))
  (check-true (token? (token 'A-TOKEN-STRUCT "hi")))
  (check-false (token? 42)))

(define/contract (tokenize port)
  (input-port? . -> . (-> token?))
  (port-count-lines! port)
  (define/contract (next-token)
    (-> token?)
    (define our-lexer
      (lexer
       [(eof) eof]
       [(from/to "//" "\n") (next-token)]
       [(from/to "@$" "$@")
        (token 'SEXP-TOK (trim-ends "@$" lexeme "$@")
               #:position (+ (pos lexeme-start) 2)
               #:line (line lexeme-start)
               #:column (+ (col lexeme-start) 2)
               #:span (- (pos lexeme-end)
                         (pos lexeme-start) 4))]
       [any-char (token 'CHAR-TOK lexeme
                        #:position (pos lexeme-start)
                        #:line (line lexeme-start)
                        #:column (col lexeme-start)
                        #:span (- (pos lexeme-end)
                                  (pos lexeme-start)))]))
    (our-lexer port))
  next-token)
(provide tokenize)

(module+ test
  (check-equal? (apply-tokenizer tokenize "// comment\n") empty)
  (check-equal?
   (apply-tokenizer tokenize "@$ (+ 6 7) $@")
   (list (token 'SEXP-TOK " (+ 6 7) "
                #:position 3
                #:line 1
                #:column 2
                #:span 9)))
  (check-equal?
   (apply-tokenizer tokenize "hi")
   (list (token 'CHAR-TOK "h"
                #:position 1
                #:line 1
                #:column 0
                #:span 1)
         (token 'CHAR-TOK "i"
                #:position 2
                #:line 1
                #:column 1
                #:span 1))))