X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=sql.lisp;h=179a452d9e3cc9dbe0d9852e36120826dc34b79d;hp=2cbd602fc4a77c17290254c955b1b8dd1548a80a;hb=abbf89f03cec17db594badafbaee4f5e1400ba94;hpb=4e78f4f0086c35ac3fd4459e3fff1186d13bc07f diff --git a/sql.lisp b/sql.lisp index 2cbd602..179a452 100644 --- a/sql.lisp +++ b/sql.lisp @@ -2,20 +2,17 @@ ;;;; ************************************************************************* ;;;; 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.5 2003/05/14 05:29:48 kevin Exp $ +;;;; $Id: sql.lisp,v 1.6 2003/06/06 21:59:29 kevin Exp $ ;;;; ;;;; 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 @@ -50,7 +47,6 @@ (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" @@ -59,19 +55,17 @@ 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" @@ -203,8 +197,6 @@ SQL name" (slot-value self name)))))))))) values)) - - (defun inverse-field-string (fields) (let (inverse) (dolist (field fields)