parse.rkt

#lang racket

(require megaparsack
         megaparsack/parser-tools/lex
         (only-in data/monad [do :do])
         (except-in data/monad do)
         data/applicative)
>
(define number/p (syntax/p (token/p 'NUMBER)))
(define string/p (syntax/p (token/p 'STRING)))
(define symbol/p (syntax/p (token/p 'SYMBOL)))
(define argument-variable/p (syntax/p (token/p 'ARGUMENT-VARIABLE)))
(define variable/p
  (syntax/p
   (or/p argument-variable/p
         symbol/p)))
(define unop/p
  (syntax/p
   (:do [op <- (or/p
                (token/p 'NEGATE)
                (token/p 'SUB))]
        [v <- expression/p]
        (pure (list op v)))))
(define binop/p
  (syntax/p
   (:do [lhs <- expression/p]
        [op <- (or/p (token/p 'GT)
                     (token/p 'GTE)
                     (token/p 'LT)
                     (token/p 'LTE)
                     (token/p 'EQ)
                     (token/p 'NEQ)
                     (token/p 'AND)
                     (token/p 'OR)
                     (token/p 'ASSIGN)
                     (token/p 'EXPONENT)
                     (token/p 'MUL)
                     (token/p 'DIV)
                     (token/p 'SUB)
                     (token/p 'ADD))]
        [rhs <- expression/p]
        (pure (list op lhs rhs)))))
(define funcall/p
  (syntax/p
   (:do [func <- symbol/p]
        (token/p 'LPAREN)
        [args <- (many/p expression/p #:sep (token/p 'COMMA))]
        (token/p 'RPAREN)
        (pure (list* func args)))))
(define expression/p
  (syntax/p
   (or/p number/p
         funcall/p
         variable/p
         #;group/p
         binop/p
         unop/p)))