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)
____________________
Racket Users list:
http://lists.racket-lang.org/users
