- (let ((cmd (format nil "CREATE TABLE ~A" (slot-value cl 'sql-name)))
- (subobjects (slot-value cl 'subobjects)))
- (dolist (esd esds)
- (unless (find (slot-definition-name esd) subobjects :key #'name-slot)
- (if (eq esd (car esds))
- (string-append cmd " (")
- (string-append cmd ", "))
- (string-append cmd (lisp-name-to-sql-name (slot-definition-name esd))
- " ")
- (let ((length (slot-value esd 'length))
- (sql-type (slot-value esd 'sql-type)))
- (string-append cmd (sql-field-cmd sql-type length)))))
- (string-append cmd ")")))
-
-
-(defun sql-field-cmd (type length)
- (case (intern (symbol-name type) (symbol-name :keyword))
+ (with-output-to-string (s)
+ (format s "CREATE TABLE ~A (~{~A~^, ~})"
+ (slot-value cl 'sql-name)
+ (loop for esd in esds
+ collect
+ (concatenate
+ 'string
+ (slot-value esd 'sql-name)
+ " "
+ (sql-type-to-field-string (slot-value esd 'sql-type)
+ (slot-value esd 'sql-length)))))))
+
+(defun sql-type-to-field-string (type length)
+ (ecase type