[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: still is obscure to me ...
From: |
David Pirotte |
Subject: |
Re: still is obscure to me ... |
Date: |
Fri, 08 Jun 2001 13:42:51 +0200 |
Martin Grabmueller wrote:
> Well, it was just an untested suggestion. I don't know much about
> GOOPS and not anything at all about your application, so it's
> difficult to say what goes wrong. If you could narrow down the
> problem, I could maybe help, but who knows...
>
> Regards,
> 'martin
Yes, and thanks so much: i also wanted to use macros, but they don't work,
or at least i can not make them work!
Here is a complete piece of code, if anybody can tell me why the macro does
not produce the expected result, where the function does ... ?
many thanks again,
david
;; -------------------------------
(define-module (alto db-utils test)
;; from distribution
;; :use-module (database postgres)
:use-module (oop goops)
;; :use-module (ice-9 format)
;; from alto
)
(export *tb-names*
*tb-attrs*
dbu/build-db-class-slots
dbu/build-db-class-1
dbu/build-db-class
dbu/sim-pg-get-bld-classes
)
(define *tb-attrs* '((("1" "ref" "text")
("2" "nom" "text")
("3" "zon" "text"))
(("4" "pos_x" "int4")
("5" "pos_y" "int4")
("6" "pos_z" "text"))
(("7" "img_x" "int2")
("8" "img_y" "int2")
("9" "img_z" "int2"))
))
(define *tb-names* '("test-1" "test-2" "test-3"))
(define (dbu/build-db-class-slots table-attrs)
(let ((slots (list 'db-oid))
(slot-defs (list '(db-oid #:accessor db-oid
#:init-keyword #:db-oid
#:init-value #f))))
(for-each (lambda (table-attr)
(let* ((attr-name (cadr table-attr))
(slot (string->symbol attr-name))
(slot-kw (symbol->keyword slot)))
(set! slots (cons slot slots))
(set! slot-defs (cons `(,slot #:accessor ,slot
#:init-keyword ,slot-kw
#:init-value #f)
slot-defs))))
table-attrs)
(values (reverse! slots)
(reverse! slot-defs))
))
;(define (dbu/build-db-class-1 class-name slot-defs slot-idts)
; (let ((defclass-form (eval `(define-class ,class-name () ,@slot-defs)))
; (export-form (eval `(export ,class-name ,@slot-idts))))
; defclass-form
; export-form
; ))
(define-macro (dbu/build-db-class-1 class-name slot-defs slot-idts)
`(begin
(define-class ,class-name () ,@slot-defs)
(export class-name ,@slot-idts)))
(define (dbu/build-db-class tb-nme tb-att)
(let ((cl-name (string->symbol (string-append "<" tb-nme ">"))))
(call-with-values
(lambda () (dbu/build-db-class-slots tb-att))
(lambda (slot-idts slot-defs)
(dbu/build-db-class-1 cl-name slot-defs slot-idts)
))))
(define (dbu/sim-pg-get-bld-classes tb-names tb-attrs)
(let ((i 0))
(for-each (lambda (tb-name)
(dbu/build-db-class tb-name
(list-ref tb-attrs i))
(set! i (+ i 1)))
tb-names)))
(dbu/sim-pg-get-bld-classes *tb-names* *tb-attrs*)