jsonic alternate

beautiful-racket/br/demo/jsonic-b/expander.rkt

@@ -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)

beautiful-racket/br/demo/jsonic-b/jsonic-test.rkt

@@ -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)) $@
+]

beautiful-racket/br/demo/jsonic-b/main.rkt

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

beautiful-racket/br/demo/jsonic-b/parser.rkt

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

beautiful-racket/br/demo/jsonic-b/reader.rkt

@@ -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)

beautiful-racket/br/demo/jsonic-b/tokenizer.rkt

@@ -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"

beautiful-racket/br/demo/jsonic/expander.rkt

@@ -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)
-  (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))) ", "))]
-    [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)))
+(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? 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 ""]))