;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: sqlgen.lisp
+;;;; Name: sql.lisp
;;;; Purpose: SQL Generation functions for Hyperobject
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: sql.lisp,v 1.3 2003/03/29 04:04:21 kevin Exp $
+;;;; $Id: sql.lisp,v 1.6 2003/06/06 21:59:29 kevin Exp $
;;;;
-;;;; This file, part of Hyperobject-SQL, is
-;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
;;;; *************************************************************************
-(in-package :hyperobject)
-(eval-when (:compile-toplevel :execute)
- (declaim (optimize (speed 2) (safety 2) (compilation-speed 0) (debug 2))))
-
+(in-package #:hyperobject)
;;;; Metaclass initialization commands
(define-inverse cl esd))))
)
-(defgeneric sql-name ((cl hyperobject-class))
+(defgeneric sql-name (cl)
)
(defmethod sql-name ((cl hyperobject-class))
(lisp-name (if name name (slot-definition-name esd))))
(lisp-name-to-sql-name lisp-name)))
-
(defun lisp-name-to-sql-name (lisp)
"Convert a lisp name (atom or list, string or symbol) into a canonical
SQL name"
(typecase lisp
(symbol (symbol-name lisp))
(t (write-to-string lisp)))))
- (let ((sql (make-string (length lisp))))
- (dotimes (i (length lisp))
- (declare (fixnum i))
- (setf (char sql i)
- (let ((c (char lisp i)))
- (case c
- (#\- #\_)
- (#\$ #\_)
- (#\+ #\_)
- (#\# #\_)
- (otherwise c)))))
- (string-upcase sql)))
-
+ (do* ((len (length lisp))
+ (sql (make-string len))
+ (i 0 (1+ i)))
+ ((= i len) (string-upcase sql))
+ (declare (fixnum i)
+ (simple-string sql))
+ (setf (schar sql i)
+ (let ((c (char lisp i)))
+ (case c
+ ((#\- #\$ #\+ #\#) #\_)
+ (otherwise c))))))
(defun define-inverse (class esd)
"Define an inverse function for a slot"
(slot-value self name))))))))))
values))
-
-
(defun inverse-field-string (fields)
(let (inverse)
(dolist (field fields)