[racket] Redefinition of initial bindings/ Resessive genes in GP

2012/7/8  <jukka.tuominen at finndesign.fi>:
>
> I came across this "mutable-define" by Eli (3+ years back)...
>
> ;; http://paste.lisp.org/display/67203
> ;; this is a PLT version, translate as necessary
>
> (define-syntax-rule (define-mutable name expr)
>   (begin (define b (box expr))
>          (define-syntax name
>            (syntax-id-rules (set!)
>              [(set! name new) (set-box! b new)]
>              [(name . xs) ((unbox b) . xs)]
>              [name (unbox b)]))))
>
> ;(define x 1)
> ;(define x 2)
>
>
> ...which seems beautifully concise for the job. The only problem is that
> it only seems to work in the interactions window in drracket. Is there a
> way to have it working inside a module? ... hopefully so that all the
> tweaks would take place inside the very module, rather than "required"
> from elsewhere (that would keep it an GP individual's property/"gene").
>
> This is obviously what Danny is trying to explain me - "...language
> variant of Racket where "define" acts like redefinition at the module
> toplevel..." - but once again, I seem to be reaching out things before
> understanding them.

Combining Dannys def and Eli's define-mutable I get this:


#lang racket

;; Returns true if stx is an identifier that's been lexically bound.
(define-for-syntax (lexically-bound? stx)
  (let ([expanded (local-expand stx (syntax-local-context) #f)])
    (not (and (identifier? expanded)
              (eq? #f (identifier-binding expanded))))))

(define-syntax (defm stx)
  (syntax-case stx ()
    [(_ name expr)
     (and (identifier? #'name) (lexically-bound? #'name))
     (syntax/loc stx (set! name expr))]
    [(_ name expr)
     (identifier? #'name)
     (syntax/loc stx
       (begin
         (define b (box expr))
         (define-syntax name
           (make-set!-transformer
            (lambda (stx)
              (syntax-case stx (set!)
                [(set! name new) #'(set-box! b new)]
                [(name . xs)     #'((unbox b) . xs)]
                [name            #'(unbox b)]))))))]))

;;; Testing

(defm x 1)
x
(list (+ x 40))
(defm x 2)
x
(list (+ x 40))
(set! x 3)
x


(defm y 4)
y
(list (+ y 40))
(defm y 5)
y
(list (+ y 40))
(set! y 6)
y


; The output is

1
'(41)
2
'(42)
3
4
'(44)
5
'(45)
6


-- 
Jens Axel Søgaard