Hi Scott,

I think that you're seeing a bug in the current expander's marshaling
of information for a compiled module, specifically for the
"metadata.rkt" module that supplies `racquel-namespace`.

(The bug was introduced in v6.3 with the set-of-scopes expander.
Happily, a re-implementation of the expander doesn't have the bug, but
the re-implementation isn't quite ready to replace the current
expander.)

I'll fix the bug as soon as I can. Meanwhile, if you'd like a
workaround:

The conflicting "lifted.0" is created in "metadata.rkt" by the contract
system's expansion of `~a`. You can work around the problem by changing

  (~a col-fld)

to

  (format "~a" col-fld)


Matthew

At Thu, 29 Sep 2016 19:22:37 -0700 (PDT), "'brown131' via Racket Users" wrote:
> I was looking through the Racket packages the other day and noticed that 
> there 
> are errors in the Racquel package that I maintain. I the error I am seeing is 
> not very helpful:
> 
> define-values: assignment disallowed;
>  cannot re-define a constant
>   constant: lifted.0
> 
> The problem is that there is no constant anywhere in the code with that name. 
> I've done some reading and it appears that is may be connected to some 
> "lifted" syntax. Through a process of elemination by commenting out code, I 
> narrowed the problem to the block of code below. In particular, if I comment 
> out the data-class* definition of the stx id and replace it with a simple 
> class definition, i.e.
> "(class object% (super-new))" the error goes away. 
> 
> My suspicion is that using the data-class* in the syntax quasi-quote is 
> somehow lifting the syntax macro to a higher run-level. But how a constant is 
> re-defined as described in all the error is beyond me.
> 
> (define (gen-data-class con tbl-nm 
>                         #:db-system-type (dbsys-type (dbsystem-type con))
>                         #:generate-joins? (gen-joins? #t)
>                         #:generate-reverse-joins? (gen-rev-joins? #t)
>                         #:schema-name (schema-nm #f)
>                         #:inherits (base-cls 'object%)
>                         #:table-name-normalizer (tbl-nm-norm (lambda (n) 
> (table-name-normalizer n))) 
>                         #:column-name-normalizer (col-nm-norm (lambda (n) 
> (column-name-normalizer n)))
>                         #:in-name-normalizer (join-nm-norm (lambda (n (c 
> 'one-to-many)) 
>                                                                
> (join-name-normalizer n c))) 
>                         #:table-name-externalizer (tbl-nm-extern (lambda (n) 
> (begin n)))
>                         #:print? (prnt? #f)
>                         . rest) 
>   (let* ([schema (load-schema con schema-nm tbl-nm #:reverse-join? 
> gen-rev-joins? 
>                               #:db-system-type dbsys-type)]
>          [cls-nm (string->symbol (tbl-nm-norm tbl-nm))]
>          [pkey (find-primary-key-fields schema col-nm-norm)]
>          [jns (if (or gen-joins? gen-rev-joins?)
>                   (get-schema-joins con schema-nm schema dbsys-type 
> tbl-nm-norm join-nm-norm 
>                                     col-nm-norm) null)]
>          [auto-key (get-autoincrement-key schema dbsys-type)]
>          [stx #`(let ([#,cls-nm 
>                        (data-class* #,base-cls (data-class<%>)
>                                     (table-name #,tbl-nm #,(tbl-nm-extern 
> tbl-nm))
>                                     #,(append '(column) (get-schema-columns 
> schema col-nm-norm))
>                                     (primary-key '#,pkey #:autoincrement 
> #,auto-key)
>                                     #,(if (and gen-joins? (list? jns) (> 
> (length jns) 0)) 
>                                           (append '(join) jns) '(begin #f))
>                                     (super-new)
>                                     #,@rest)
>                        ])
>                   (get-class-metadata-object #,cls-nm)
>                   #,cls-nm)])
>     (if prnt? (syntax->datum stx) (eval-syntax stx racquel-namespace)))) 
> 
> Here is the syntax definition for the data-class*:
> 
> ;;; Define a data class with interfaces.
> (define-syntax (data-class* stx)
>   (syntax-parse stx 
>     [(_ base-cls:id (i-face:id ...) elem:data-class-element ...) 
>      (with-syntax ([cls-id (generate-temporary #'class-id-)]
>                    [m-data (generate-temporary #'metadata-)]
>                    [ctxt ctxt-id]
>                    [set-auto-pkey! set-auto-pkey!-id]
>                    [set-pkey! set-pkey!-id]
>                    [set-tbl-nm-m-data! set-tbl-nm-m-data!-id]
>                    [jn-fld jn-fld-id]
>                    [jn-cls jn-cls-id]
>                    [con con-id]
>                    [dbsys-type dbsys-type-id])
>        #'(let* ([ctxt null]
>                 [m-data (new data-class-metadata%)]
>                 [set-tbl-nm-m-data! (λ (tbl-nm extern-nm) (set-field! 
> table-name m-data tbl-nm) 
>                                       (set-field! external-name m-data 
> extern-nm))]
>                 [set-auto-pkey! (λ (pkey flag) (set-field! primary-key m-data 
> pkey) 
>                                   (when flag (set-field! autoincrement-key 
> m-data flag)))]
>                 [set-pkey! (λ (pkey) (set-field! primary-key m-data pkey))])
>            (unless (hash-has-key? *data-class-metadata* 'cls-id)
>              elem.meta-expr ...
>              (set-field! columns m-data (sort (append elem.col-defs ...) 
> string<? 
>                                          #:key (lambda (k) (symbol->string 
> (first k)))))
>              (set-field! joins m-data (append elem.jn-defs ...))
>              (hash-set! *data-class-metadata* 'cls-id m-data))
>            (define-member-name cls-id (get-field class-id-key m-data))
>            (define-member-name data-object-state (get-field state-key m-data))
>            (class* base-cls (data-class<%> i-face ...) 
>              elem.cls-expr ...
>              (field [cls-id #f]
>                     [data-object-state 'new])
>              (inspect #f)
>              (define/public (set-data-join! con jn-fld jn-cls)
>                (let* ([dbsys-type (dbsystem-type con)]
>                       [rows (append elem.jn-rows ...)])
>                  (map (lambda (r) (let ([obj (new jn-cls)])
>                                     (map (lambda (f v) (dynamic-set-field! f 
> obj v)) 
>                                          (get-column-ids jn-cls) 
> (vector->list 
> r))
>                                     (define-member-name data-object-state 
>                                       (get-class-metadata state-key jn-cls))
>                                     (set-field! data-object-state obj 'loaded)
>                                     obj)) rows)))
>              (define/private (base-data-class cls)
>                (let-values ([(cls-nm fld-cnt fld-nms fld-acc fld-mut sup-cls 
> skpd?) (class-info cls)])
>                  (if (data-class? cls) (if sup-cls (base-data-class sup-cls) 
> cls) cls)))            
>              (unless (get-field class (hash-ref *data-class-metadata* 
> 'cls-id))
>                (set-field! class (hash-ref *data-class-metadata* 'cls-id) 
>                            (base-data-class this%))))))]))
> 
> Source complete can be found here 
> https://github.com/brown131/racquel/blob/master/main.rkt
> 
> It's been a while since I've worked with this, and am admittedly a little 
> rusty on Racket syntax manipulation. Any help would be appreciated. Thanks.
> 
> -Scott
> 
> -- 
> You received this message because you are subscribed to the Google Groups 
> "Racket Users" group.
> To unsubscribe from this group and stop receiving emails from it, send an 
> email to racket-users+unsubscr...@googlegroups.com.
> For more options, visit https://groups.google.com/d/optout.

-- 
You received this message because you are subscribed to the Google Groups 
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

Reply via email to