dev-srcloc
Matthew Butterick 8 years ago
parent 6184ebb3e1
commit b6a45815ab

@ -0,0 +1,4 @@
#lang brag
jsonic-program: (s-exp | json-char)*
s-exp: SEXP-TOK
json-char: CHAR-TOK

@ -1,4 +1,4 @@
#lang brag #lang brag
jsonic-program: (s-exp | json-char)* jsonic-program: (s-exp | json-char)*
s-exp: SEXP-TOK s-exp: SEXP-TOK
json-char: CHAR-TOK json-char: CHAR-TOK CHAR-TOK

@ -1,12 +1,10 @@
#lang br/quicklang #lang br/quicklang
(require "tokenizer.rkt" "parser.rkt") (require "tokenizer.rkt" "parser.rkt")
(define (syntax-no-bindings? stx)
(and (syntax? stx)
(equal? stx (strip-bindings stx))))
(define/contract (read-syntax path port) (define/contract (read-syntax path port)
(path? input-port? . -> . syntax?) (path? input-port? . -> . syntax?)
(define parse-tree (parse path (tokenize port))) (define parse-tree (parse path (tokenize port)))
(define module-datum `(module jsonic-module br/demo/jsonic/expander (define module-datum `(module jsonic-module jsonic/expander
,parse-tree)) ,parse-tree))
(datum->syntax #f module-datum)) (datum->syntax #f module-datum))
(provide read-syntax) (provide read-syntax)

@ -1,9 +1,18 @@
#lang br/quicklang #lang br/quicklang
(require brag/support) (require brag/support)
(module+ test
(require rackunit))
(define (token? x) (define (token? x)
(or (eof-object? x) (string? x) (token-struct? 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) (define/contract (tokenize port)
(input-port? . -> . (-> token?)) (input-port? . -> . (-> token?))
(define/contract (next-token) (define/contract (next-token)
@ -17,4 +26,14 @@
[any-char (token 'CHAR-TOK lexeme)])) [any-char (token 'CHAR-TOK lexeme)]))
(our-lexer port)) (our-lexer port))
next-token) next-token)
(provide tokenize) (provide tokenize)
(module+ test
(check-equal? (apply-tokenizer tokenize "// comment\n") empty)
(check-equal?
(apply-tokenizer tokenize "@$ (+ 6 7) $@")
(list (token-struct 'SEXP-TOK " (+ 6 7) " #f #f #f #f #f)))
(check-equal?
(apply-tokenizer tokenize "hi")
(list (token-struct 'CHAR-TOK "h" #f #f #f #f #f)
(token-struct 'CHAR-TOK "i" #f #f #f #f #f))))
Loading…
Cancel
Save