improve tokenizer macros

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

@@ -0,0 +1,4 @@
+#lang br/quicklang
+(module reader br/quicklang
+  (require (submod "jsonic-b/main.rkt" reader))
+  (provide (all-from-out (submod "jsonic-b/main.rkt" reader))))

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

@@ -1,37 +1,20 @@
 #lang br/quicklang
-
 (require json)
 (define-macro (js-module-begin PARSE-TREE)
   #'(#%module-begin
      (define result-string PARSE-TREE)
-     (when (string->jsexpr result-string)
+     (define validated-jsexpr (string->jsexpr result-string))
-       (display result-string))))
+     (display (jsexpr->string validated-jsexpr))))
 (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)
+(define-macro (json-char CHAR-STR) #'CHAR-STR)
-  #'TOKEN)
 (provide json-char)
 
-(define (list->json x)
+(define-macro (s-exp SEXP-STR)
-  (format "[~a]" (string-join (map ->string x) ", ")))
+  (with-pattern ([SEXP-DATUM (format-datum '~a (syntax->datum #'SEXP-STR))])
-
+    #'(jsexpr->string SEXP-DATUM)))
-(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

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

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

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

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

@@ -2,7 +2,7 @@
 (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
+  (define module-datum `(module jsonic-module br/demo/jsonic-b/expander
                           ,parse-tree))
   (datum->syntax #f module-datum))
 (provide read-syntax)

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

@@ -5,15 +5,10 @@
     (define our-lexer
       (lexer
        [(eof) eof]
-       [(:seq "//" (:* (char-complement "\n"))) (next-token)]
+       [(delimited-by "//" "\n") (next-token)]
-       [(:seq "@$" (complement (:seq any-string "$@" any-string)) "$@")
+       [(delimited-by "@$" "$@")
-        (let ([trimmed-lexeme (string-trim (string-trim lexeme "$@") "@$")])
+        (token 'SEXP-TOK (trim-delimiters "@$" lexeme "$@"))]
-          (token 'SEXP trimmed-lexeme))]
+       [any-char (token 'CHAR-TOK 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"

brag/brag/brag.scrbl

@@ -986,6 +986,15 @@ In addition to the exports shown below, the @racketmodname[brag/lexer-support] m
 Repeatedly apply @racket[tokenizer] to @racket[source-string], gathering the resulting tokens into a list. Useful for testing or debugging a tokenizer.
 }
 
+
+@defproc[(trim-delimiters [left-delimiter string?]
+[str string?]
+[right-delimiter string?])
+         string?]{
+Remove @racket[left-delimiter] from the left side of @racket[str], and @racket[right-delimiter] from its right side. Intended as a helper function for @racket[delimited-by].
+}
+
+
 @defform[(:* re ...)]{
 
 Repetition of @racket[re] sequence 0 or more times.}
@@ -1045,5 +1054,9 @@ one character.}
 Character ranges, matching characters between successive pairs of
 characters.}
 
+@defform[(delimited-by open close)]{
+
+A string that is bounded by the @racket[open] and @racket[close] delimiters. Matching is non-greedy (meaning, it stops at the first occurence of @racket[close]). The resulting lexeme includes the delimiters. To remove them, see @racket[trim-delimiters].}
+
 
 @close-eval[my-eval]

brag/brag/lexer-support.rkt

@@ -1,7 +1,9 @@
 #lang racket/base
 (require "support.rkt"
          parser-tools/lex
-         (prefix-in : parser-tools/lex-sre))
+         racket/string
+         (prefix-in : parser-tools/lex-sre)
+         (for-syntax racket/base))
 (provide (all-from-out "support.rkt")
          (all-from-out parser-tools/lex)
          (all-from-out parser-tools/lex-sre)
@@ -14,3 +16,12 @@
     (define token-producer (tokenize input-port))
     (for/list ([token (in-producer token-producer eof)])
               token))
+
+(define (trim-delimiters left lexeme right)
+  (string-trim (string-trim lexeme left #:right? #f) right #:left? #f))
+
+(define-lex-trans delimited-by
+  (λ(stx)
+    (syntax-case stx ()
+      [(_ OPEN CLOSE)
+       #'(:seq OPEN (complement (:seq any-string CLOSE any-string)) CLOSE)])))