jsonic alternate

dev-srcloc
Matthew Butterick 8 years ago
parent 3a6c74360c
commit ece5a5c290

@ -0,0 +1,37 @@
#lang br/quicklang
(require json)
(define-macro (js-module-begin PARSE-TREE)
#'(#%module-begin
(define result-string PARSE-TREE)
(when (string->jsexpr result-string)
(display result-string))))
(provide (rename-out [js-module-begin #%module-begin]))
(define-macro (jsonic-program S-EXP-OR-JSON-CHAR ...)
#'(string-trim (string-append S-EXP-OR-JSON-CHAR ...)))
(provide jsonic-program)
(define-macro (json-char TOKEN)
#'TOKEN)
(provide json-char)
(define (list->json x)
(format "[~a]" (string-join (map ->string x) ", ")))
(define (hash->json x)
(format "{~a}" (string-join (for/list ([(k v) (in-hash x)])
(format "~a: ~a" (->string k) (->string v))) ", ")))
(define (->string x)
(cond
[(number? x) (number->string x)]
[(string? x) (format "~v" x)]
[(list? x) (list->json x)]
[(hash? x) (hash->json x)]
[else ""]))
(define-macro (s-exp EXP-STRING)
(with-pattern ([EXP-DATUM (format-datum '~a (syntax->datum #'EXP-STRING))])
#'(->string EXP-DATUM)))
(provide s-exp)

@ -0,0 +1,10 @@
#lang br/demo/jsonic
// a line comment
[
@$ (* 6 7) $@,
@$ "string" $@,
@$ (list "array" "of" "strings") $@,
@$ (hash "key-1" 42
"key-2" "value"
"key-3" (hash "subkey" 21)) $@
]

@ -0,0 +1,4 @@
#lang br/quicklang
(module reader br
(require "reader.rkt")
(provide read-syntax))

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

@ -0,0 +1,8 @@
#lang br/quicklang
(require "tokenizer.rkt" "parser.rkt")
(define (read-syntax path port)
(define parse-tree (parse path (tokenize port)))
(define module-datum `(module jsonic-module br/demo/jsonic/expander
,parse-tree))
(datum->syntax #f module-datum))
(provide read-syntax)

@ -0,0 +1,19 @@
#lang br/quicklang
(require brag/lexer-support)
(define (tokenize port)
(define (next-token)
(define our-lexer
(lexer
[(eof) eof]
[(:seq "//" (:* (char-complement "\n"))) (next-token)]
[(:seq "@$" (complement (:seq any-string "$@" any-string)) "$@")
(let ([trimmed-lexeme (string-trim (string-trim lexeme "$@") "@$")])
(token 'SEXP trimmed-lexeme))]
[any-char (token 'CHAR lexeme)]))
(our-lexer port))
next-token)
(provide tokenize)
;; (char-complement "\n") means any char but "\n"
;; (complement "\n") means any whole string except "\n"

@ -1,34 +1,37 @@
#lang br/quicklang
(require json)
(define-macro (jsonic-mb PARSE-TREE)
(define-macro (js-module-begin PARSE-TREE)
#'(#%module-begin
(define json-string PARSE-TREE)
(when (string->jsexpr json-string)
(display json-string))))
(provide (rename-out [jsonic-mb #%module-begin]))
(define result-string PARSE-TREE)
(when (string->jsexpr result-string)
(display result-string))))
(provide (rename-out [js-module-begin #%module-begin]))
(define-macro (jsonic-program TOK ...)
#'(string-trim (string-append TOK ...)))
(define-macro (jsonic-program S-EXP-OR-JSON-CHAR ...)
#'(string-trim (string-append S-EXP-OR-JSON-CHAR ...)))
(provide jsonic-program)
(define-macro (json-char TOK)
#'TOK)
(define-macro (json-char TOKEN)
#'TOKEN)
(provide json-char)
(define (stringify result)
(define-macro (s-exp TOKEN ...)
(define token-stxs (syntax->list #'(TOKEN ...)))
(define token-strs (map syntax->datum token-stxs))
(define s-exp-str (apply string-append token-strs))
(with-pattern ([S-EXP-DATUM (format-datum '~a s-exp-str)])
#'(->json S-EXP-DATUM)))
(provide s-exp)
(define (->json x)
(cond
[(number? result) (number->string result)]
[(string? result) (format "~v" result)]
[(list? result) (format "[~a]" (string-join (map stringify result) ", "))]
[(hash? result) (format "{~a}" (string-join (for/list ([(k v) (in-hash result)])
(format "~a: ~a" (stringify k) (stringify v))) ", "))]
[(number? x) (number->string x)]
[(string? x) (format "~v" x)]
[(list? x)
(format "[~a]" (string-join (map ->json x) ", "))]
[(hash? x)
(define pair-strs (for/list ([(k v) (in-hash x)])
(format "~a: ~a"
(->json k) (->json v))))
(format "{~a}" (string-join pair-strs ", "))]
[else ""]))
(require (for-syntax br/datum racket/string))
(define-macro (s-exp TOK ...)
(define s-exp-string
(string-join (map syntax->datum (syntax->list #'(TOK ...))) ""))
(with-pattern ([DATUM (format-datum '~a s-exp-string)])
#'(stringify DATUM)))
(provide s-exp)

Loading…
Cancel
Save