add basic colorer

beautiful-racket-demo/basic-demo-2/colorer.rkt

@@ -0,0 +1,22 @@
+#lang br
+(require "lexer.rkt" brag/support)
+(provide color-basic)
+
+(define (color-basic port)
+  (define srcloc-tok (basic-lexer port))
+  (match srcloc-tok
+    [(? eof-object?) (values srcloc-tok 'eof #f #f #f)]
+    [else ; reverse-engineer with `match-define`
+     (match-define (srcloc-token (token-struct type val _ _ _ _ _)
+                                 (srcloc _ _ _ pos span)) srcloc-tok)
+     (define (color cat [paren #f])
+       (values (or val "") cat paren pos (+ pos span)))
+     (match type
+       ['STRING (color 'string)]
+       ['REM (color 'comment)]
+       [else (match val
+               [(? number?) (color 'constant)]
+               [(? symbol?) (color 'symbol)]
+               ["(" (color 'parenthesis '|(|)]
+               [")" (color 'parenthesis '|)|)]
+               [else (color 'no-color)])])]))

beautiful-racket-demo/basic-demo-2/lexer.rkt

@@ -10,7 +10,7 @@
    [whitespace (token lexeme #:skip? #t)]
    [(from/stop-before "rem" "\n") (token 'REM lexeme)]
    [(:or "print" "goto" "end" "+" ":" "gosub" "return" "let" "=" "-" "for" "to" "step" "next"
-         "if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") lexeme]
+         "if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") (token lexeme lexeme)]
    [(:seq (:+ alphabetic) (:* (:or alphabetic numeric "$"))) (token 'ID (string->symbol lexeme))]
    [digits (token 'INTEGER (string->number lexeme))]
    [(:or (:seq (:? digits) "." digits)

beautiful-racket-demo/basic-demo-2/main.rkt

@@ -1,11 +1,19 @@
 #lang br/quicklang
 (require "parser.rkt" "tokenizer.rkt")
 
+(module+ reader
+  (provide read-syntax get-info))
+
 (define (read-syntax path port)
   (define parse-tree (parse path (make-tokenizer port path)))
   (strip-bindings
    #`(module basic-mod basic-demo-2/expander
        #,parse-tree)))
 
-(module+ reader
+(define (get-info port mod line col pos)
-  (provide read-syntax))
+    (define (handle-query key default)
+      (case key
+        [(color-lexer)
+         (dynamic-require 'basic-demo-2/colorer 'color-basic)]
+        [else default]))
+    handle-query)