silly.rkt

#lang br
(require br-parser-tools/lex brag/support br/macro "grammar.rkt")

(define-lex-abbrev digits (:+ numeric))
(define-lex-abbrev reserved-terms
  (:or "+" "-" "*" "/" "=" "in" ";" "{" "}" "(" ")" "," "=>" "if" "then" "else" "==" "<"))

(define (tokenize ip)
    (port-count-lines! ip)
    (define my-lexer
      (lexer-srcloc
        [whitespace (token lexeme #:skip? #t)]
        [reserved-terms (token lexeme lexeme)]
        [(:seq digits "." digits)
           (token 'NUMBER (exact->inexact (string->number lexeme)))]
        [digits (token 'NUMBER (string->number lexeme))]        
        [(:seq alphabetic (:* (:or alphabetic numeric)))
           (token 'NAME (string->symbol lexeme))]
        [(eof) (void)] ))
    (lambda () (my-lexer ip)))

(module m br
  (provide anchor)
  (define-namespace-anchor anchor)  
  
  (define-macro-cases s-term
    [(_ VAL) #'VAL]
    [(_ LEFT "+" RIGHT) #'(+ LEFT RIGHT)]
    [(_ LEFT "-" RIGHT) #'(- LEFT RIGHT)])

  (define-macro-cases s-summand
    [(_ VAL) #'VAL]
    [(_ LEFT "*" RIGHT) #'(* LEFT RIGHT)]
    [(_ LEFT "/" RIGHT) #'(/ LEFT RIGHT)]
    [(_ "-" VAL) #'(- VAL)])

  (define-macro-cases s-compterm
    [(_ VAL) #'VAL]
    [(_ LEFT "<" RIGHT) #'(< LEFT RIGHT)]
    [(_ LEFT "==" RIGHT) #'(eq? LEFT RIGHT)])
  
  (define-macro (s-name X) #'X)
  (define-macro (s-expr X) #'X)
  (define-macro (s-prog STMT ...) #'(begin (s-top STMT) ... ))
  
  (define-macro-cases s-top
    [(s-top (s-assn V E)) #'(define V E)]
    [(s-top (s-fundef FUN VS ... "=>" E)) #'(define (FUN VS ...) E)]
    [(s-top (s-expr E)) #'E])

  (define-macro-cases s-block
    [(s-block E) #'E]
    [(s-block (s-assn VAR VAL) MORE ... E) #'(let ((VAR VAL)) (s-block MORE ... E))]
    [(s-block (s-fundef FUN VS ... "=>" VAL) MORE ... E)
       #'(begin (define (FUN VS ...) VAL) (s-block MORE ... E))]
    [(s-block (s-expr VAL) MORE ... E)
       #'(begin VAL (s-block MORE ... E))])
  
  (define-macro (s-funcall FUN ARGS ...) #'(FUN ARGS ...))  
  (define (print . xs) (displayln xs))
)
(require 'm)
(define ns (namespace-anchor->namespace anchor))

(define (run input)
  (define stx (parse (tokenize input)))
  (eval stx ns))

(define argv (current-command-line-arguments))
(if ((vector-length argv) . > . 0)
    (time (run (open-input-file (vector-ref argv 0))))
    (run (open-input-string "print(4, 6, 2+2*3)")))