[racket] [Racket Syntax] Check if identifier is lexically bound

From: Chrisophe Vandenberghe (chvndb at gmail.com)
Date: Mon Mar 3 14:18:20 EST 2014

If  you run the code (the last one I posted) it outputs '(1 2 #<void> #<void>). But, I want it to output '(1 2 1 #<void>).
There is a (define c 1) which is not recognised in my implementation. 

The only solution I have found so far is to keep a list during syntax expansion which keeps track of local definitions and which is reset when a new METHOD is encountered. Below is the result code which outputs what I want. This allows me to do more useful stuff then to return void when the identifier is not found. 

Is it really that hard to understand? Should i re-write my code and not use syntax-classes? I know the example is unclear cause this syntax simply returns a method, but that is not the point. My entire implementation is 500 LOC, so I had to simplify it to post it.
 
#lang racket

(require (for-syntax syntax/parse))

(define-for-syntax (lexically-bound? stx)
  (define expanded (local-expand stx (syntax-local-context) #f))
  (and (identifier? expanded)
       (not (eq? #f (identifier-binding expanded)))))

(define-for-syntax (local-parameter? stx pars-stx)
  (ormap (lambda (par) (bound-identifier=? stx par)) (syntax-e pars-stx)))

(define-syntax (CLASS stx)
  
  ;; Literal
  
  (define-syntax-class (literal)
    (pattern value:boolean)
    (pattern value:char)
    (pattern value:integer)
    (pattern value:number)
    (pattern value:str))
  
  ;; Current local definition (used during every method expansion)
  
  (define current-local-defs '())
  
  ;; Arg List
  
  (define-splicing-syntax-class (arg-list)
    (pattern (~seq arg:id ...)
             #:do [(set! current-local-defs '())]))
  
  ;; Class Expression (validates all expressions inside a class)
  
  (define-syntax-class (class-expr args)
    
    #:datum-literals (define)
    #:commit
    
    (pattern value:literal
             #:with <value> #'value)
    (pattern value:id
             #:with <value> (if (or (lexically-bound? #'value)
                                    (local-parameter? #'value args)
                                    (member (syntax-e #'value) current-local-defs))
                                #'value 
                                #'(void)))
    (pattern (define name:id (~var arg (class-expr args)))
             #:with <value> #'(define name arg.<value>)
             #:do [(set! current-local-defs (cons (syntax-e #'name) current-local-defs))])
    (pattern (operator:id (~var arg (class-expr args)) ...)
             #:with <value> #'(operator arg.<value> ...)))
  
  ;; Method Class
  
  (define-syntax-class (class-method)
    
    #:datum-literals (METHOD)
    
    (pattern (METHOD (name:id (~var arg-list arg-list)) (~var body (class-expr #'arg-list)) ...)
             #:with <value> #'(define (name arg-list.arg ...) body.<value> ...)))
  
  ;;;;; Class Parser
  
  (syntax-parse 
   stx
   
   #:datum-literals (CLASS)
   
   [(CLASS <method>:class-method)
    #'<method>.<value>]))

(CLASS

 (METHOD (test a b) (define c 1) (list a b c d)))

(test 1 2)

Posted on the users mailing list.