#lang racket/base

;; This file is not used by the project, but can be used as a base for macros
;; which need to parse the result of local-expand. For example, the file
;; fully-expanded-grammar-extract-bindings.rkt is based on this one.

(require (rename-in syntax/parse [...+ …+])
         (rename-in racket/base [... …])
         (for-template '#%kernel)
         (for-syntax racket/base))

(provide disallow-set!-in-expression)

(define whole-expr (make-parameter #f))

(define (disallow-set!-in-expression e)
  (parameterize ([whole-expr e])
    (syntax-parse e [:expr 'ok])))

(define-syntax-class top-level-form
  #:literals (#%expression module #%plain-module-begin begin begin-for-syntax)
  (pattern :general-top-level-form)
  (pattern (#%expression :expr))
  (pattern (module :id _module-path
             (#%plain-module-begin
              :module-level-form …)))
  (pattern (begin :top-level-form …))
  (pattern (begin-for-syntax :top-level-form …)))
 	 	 	 	 
(define-syntax-class module-level-form
  #:literals (#%provide begin-for-syntax #%declare)
  (pattern :general-top-level-form)
  (pattern (#%provide _raw-provide-spec …))
  (pattern (begin-for-syntax :module-level-form …))
  (pattern :submodule-form)
  (pattern (#%declare _declaration-keyword …)))
 	 	 	 	 
(define-syntax-class submodule-form
  #:literals (module #%plain-module-begin module* )
  (pattern (module :id _module-path
             (#%plain-module-begin
              :module-level-form …)))
  (pattern (module* :id _module-path
             (#%plain-module-begin
              :module-level-form …)))
  (pattern (module* :id #f
             (#%plain-module-begin
              :module-level-form …))))
  
(define-syntax-class general-top-level-form
  #:literals (define-values define-syntaxes #%require)
  (pattern :expr)
  (pattern (define-values (:id …) :expr))
  (pattern (define-syntaxes (:id …) :expr))
  (pattern (#%require _raw-require-spec …)))
 	 	 	 	 
(define-syntax-class expr
  #:literals (lambda case-lambda if begin begin0
               let-values letrec-values letrec-syntaxes+values
               set! quote quote-syntax
               with-continuation-mark
               #%app #%top #%expression #%variable-reference)
  (pattern :id)
  (pattern (lambda :formals :expr …+))
  (pattern (case-lambda (:formals :expr …+) …))
  (pattern (if :expr :expr :expr))
  (pattern (begin :expr …+))
  (pattern (begin0 :expr :expr …))
             
  (pattern (let-values ([(:id …) :expr] …)
             :expr …+))
  (pattern (letrec-values ([(:id …) :expr] …)
             :expr …+))
  (pattern (letrec-syntaxes+values ([(:id …) :expr] …)
             ([(:id …) :expr] …)
             :expr …+))
  (pattern {~and whole-set ({~and set-id set!} :id :expr)}
           #:do [(raise-syntax-error
                  'pure
                  "set! is disallowed within pure/stateless and similar forms"
                  #'whole-expr
                  #'whole-set
                  (list #'set-id))])
  (pattern (quote _datum))
  (pattern (quote-syntax _datum))
  (pattern (quote-syntax _datum #:local))
  (pattern (with-continuation-mark :expr :expr :expr))
  (pattern (#%app :expr …+))
  (pattern (#%top . :id))
  (pattern (#%expression :expr))
  (pattern (#%variable-reference :id))
  (pattern (#%variable-reference (#%top . :id)))
  (pattern (#%variable-reference)))

(define-syntax-class formals
  (pattern (:id …))
  (pattern (:id …+ . :id))
  (pattern :id))