From abbf89f03cec17db594badafbaee4f5e1400ba94 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 6 Jun 2003 21:59:30 +0000 Subject: [PATCH] r5062: return from san diego --- base-class.lisp | 6 ++---- connect.lisp | 6 ++---- metaclass.lisp | 8 ++------ mop.lisp | 7 ++----- package.lisp | 7 ++----- rules.lisp | 7 ++----- sql.lisp | 36 ++++++++++++++---------------------- views.lisp | 7 ++----- 8 files changed, 28 insertions(+), 56 deletions(-) diff --git a/base-class.lisp b/base-class.lisp index 4b65c8d..9682f3d 100644 --- a/base-class.lisp +++ b/base-class.lisp @@ -7,14 +7,12 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: base-class.lisp,v 1.9 2003/05/22 20:40:03 kevin Exp $ +;;;; $Id: base-class.lisp,v 1.10 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) (defclass hyperobject () diff --git a/connect.lisp b/connect.lisp index 05a8735..742d956 100644 --- a/connect.lisp +++ b/connect.lisp @@ -7,14 +7,12 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: connect.lisp,v 1.3 2003/05/14 05:29:48 kevin Exp $ +;;;; $Id: connect.lisp,v 1.4 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) (defvar *ho-sql-db* "ho") (defun ho-sql-db () diff --git a/metaclass.lisp b/metaclass.lisp index 321a4b0..60c89d2 100644 --- a/metaclass.lisp +++ b/metaclass.lisp @@ -8,17 +8,13 @@ ;;;; Date Started: Apr 2000 ;;;; ;;;; -;;;; $Id: metaclass.lisp,v 1.7 2003/05/14 05:29:48 kevin Exp $ +;;;; $Id: metaclass.lisp,v 1.8 2003/06/06 21:59:29 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* -(in-package :hyperobject) +(in-package #:hyperobject) -(eval-when (:compile-toplevel :execute) - (declaim (optimize (speed 2) (safety 2) (compilation-speed 0) (debug 2)))) - - (defparameter *class-options* '(:user-name :default-print-slots :description :version :sql-name :direct-rules) diff --git a/mop.lisp b/mop.lisp index 695b4e9..19e2743 100644 --- a/mop.lisp +++ b/mop.lisp @@ -11,15 +11,12 @@ ;;;; in Text, HTML, and XML formats. This includes hyperlinking ;;;; capability and sub-objects. ;;;; -;;;; $Id: mop.lisp,v 1.75 2003/05/26 21:43:05 kevin Exp $ +;;;; $Id: mop.lisp,v 1.76 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) ;; Main class diff --git a/package.lisp b/package.lisp index 25f5a4f..2cff019 100644 --- a/package.lisp +++ b/package.lisp @@ -7,15 +7,12 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.48 2003/05/17 22:24:38 kevin Exp $ +;;;; $Id: package.lisp,v 1.49 2003/06/06 21:59:29 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg ;;;; ************************************************************************* -(eval-when (:compile-toplevel :execute) - (declaim (optimize (speed 2) (safety 2) (compilation-speed 0) (debug 2)))) - -(in-package :cl-user) +(in-package #:cl-user) #+sbcl (eval-when (:compile-toplevel :load-toplevel :execute) diff --git a/rules.lisp b/rules.lisp index fcce008..6a07452 100644 --- a/rules.lisp +++ b/rules.lisp @@ -7,15 +7,12 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: rules.lisp,v 1.45 2003/05/17 05:39:35 kevin Exp $ +;;;; $Id: rules.lisp,v 1.46 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) ;;; Slot accessor and class rules 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) diff --git a/views.lisp b/views.lisp index dfd6aaa..b9097a1 100644 --- a/views.lisp +++ b/views.lisp @@ -7,15 +7,12 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: views.lisp,v 1.49 2003/05/30 18:46:35 kevin Exp $ +;;;; $Id: views.lisp,v 1.50 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) (defclass object-view () -- 2.34.1