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.
