X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=b163e0bbd657a5f4ecea92c8fe537684c98c5238;hb=baef3e3eba503d04fe6d19ac3087bf9d3dbc37b9;hp=6cd2c46e14613f5e0533c45e657f8bf7a02adc01;hpb=4087c342d473dce4a4dfc7812704e9e5805a3669;p=umlisp.git

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 6cd2c46..b163e0b 100644
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-classes.lisp,v 1.10 2002/11/12 18:05:00 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.11 2002/12/09 14:11:09 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -26,44 +26,6 @@
 (defun current-srl! (srl)
   (setq *current-srl* srl))
 
-
-;;; Accessors (read on demand)
-
-;; defines a slot-unbound method for class and slot-name, fills
-;; the slot by calling reader function with the slot values of
-;; the instance's reader-keys
-(defmacro def-lazy-reader (class slot-name reader &rest reader-keys)
-  (let* ((the-slot-name (gensym))
-	 (the-class (gensym))
-	 (the-instance (gensym))
-	 (keys '()))
-    (dolist (key reader-keys)
-      (push (list 'slot-value the-instance (list 'quote key)) keys))
-    (setq keys (nreverse keys))
-    `(defmethod slot-unbound (,the-class (,the-instance ,class)
-					 (,the-slot-name (eql ',slot-name)))
-       (declare (ignore ,the-class))
-       (setf (slot-value ,the-instance ,the-slot-name)
-	   (,reader ,@keys)))))
-
-(def-lazy-reader ucon s#term find-uterm-cui cui)
-(def-lazy-reader ucon s#def find-udef-cui cui)
-(def-lazy-reader ucon s#sty find-usty-cui cui)
-(def-lazy-reader ucon s#rel find-urel-cui cui)
-(def-lazy-reader ucon s#coc find-ucoc-cui cui)
-(def-lazy-reader ucon s#lo find-ulo-cui cui)
-(def-lazy-reader ucon s#atx find-uatx-cui cui)
-(def-lazy-reader ucon s#sat find-usat-ui cui)
-
-;; For uterms
-(def-lazy-reader uterm s#str find-ustr-cuilui cui lui)
-(def-lazy-reader uterm s#sat find-usat-ui cui lui)
-
-;; For ustrs
-(def-lazy-reader ustr s#sat find-usat-ui cui lui sui)
-(def-lazy-reader ustr s#cxt find-ucxt-cuisui cui sui)
-(def-lazy-reader ustr s#so find-uso-cuisui cui sui)
-
 ;;; Object lookups
 
 ;;; Lookup functions for uterms,ustr in ucons
@@ -102,70 +64,66 @@
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
-  (if (stringp lui)
-      (setq lui (parse-lui lui)))
-  (if lui
+  (when (stringp lui) (setq lui (parse-lui lui)))
+  (when lui
       (let ((ucons '())
 	    (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where LUI=~d" lui)))
 	(if srl
 	    (string-append ls (format nil " and KCUILRL <= ~d" srl)))
 	(dolist (tuple (mutex-sql-query ls))
-	  (push (make-instance 'ucon :cui (ensure-integer (nth 0 tuple))
-			       :pfstr (nth 1 tuple)
-			       :lrl (ensure-integer (nth 2 tuple)))
-		ucons))
-	(nreverse ucons))
-    nil))
+	  (destructuring-bind (cui pfstr lrl) tuple
+	    (push (make-instance 'ucon :cui (ensure-integer cui)
+				 :pfstr pfstr
+				 :lrl (ensure-integer lrl))
+		  ucons)))
+	(nreverse ucons))))
 
 (defun find-ucon-sui (sui &key (srl *current-srl*))
   "Find list of ucon for sui"
-  (if (stringp sui)
-      (setq sui (parse-sui sui)))
-  (if sui
-      (let ((ucons '())
-	    (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where SUI=~d" sui)))
-	(when srl
-	    (string-append ls (format nil " and KCUILRL <= ~d" srl)))
-	(let ((tuples (mutex-sql-query ls)))
-	  (dolist (tuple tuples)
-	    (push (make-instance 'ucon :cui (ensure-integer (nth 0 tuple)) 
-				 :pfstr (nth 1 tuple)
-				 :lrl (ensure-integer (nth 2 tuple)))
-		  ucons)))
-    (nreverse ucons))
-  nil))
+  (when (stringp sui) (setq sui (parse-sui sui)))
+  (when sui
+    (let ((ucons '())
+	  (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where SUI=~d" sui)))
+      (when srl
+	(string-append ls (format nil " and KCUILRL <= ~d" srl)))
+      (let ((tuples (mutex-sql-query ls)))
+	(dolist (tuple tuples)
+	  (destructuring-bind (cui pfstr lrl) tuple
+	    (push (make-instance 'ucon :cui (ensure-integer cui)
+				 :pfstr pfstr
+				 :lrl (ensure-integer lrl))
+		  ucons))))
+      (nreverse ucons))))
 
 (defun find-ucon-cuisui (cui sui &key (srl *current-srl*))
   "Find ucon for cui/sui"
-  (if (stringp cui)
-      (setq cui (parse-cui cui)))
-  (if (stringp sui)
-      (setq sui (parse-sui sui)))
-  (if (and cui sui)
-      (let ((ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where KCUISUI=~d"
-			(make-cuisui cui sui))))
-	(when srl
-	    (string-append ls (format nil " and KCUILRL <= ~d" srl)))
-	(kmrcl:aif (car (mutex-sql-query ls))
-	     (make-instance 'ucon :cui (ensure-integer (nth 0 kmrcl::it)) 
-			    :pfstr (nth 1 kmrcl::it)
-			    :lrl (ensure-integer (nth 2 kmrcl::it)))
-	     nil))
-    nil))
+  (when (stringp cui) (setq cui (parse-cui cui)))
+  (when (stringp sui) (setq sui (parse-sui sui)))
+  (when (and cui sui)
+    (let ((ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where KCUISUI=~d"
+		      (make-cuisui cui sui))))
+      (when srl
+	(string-append ls (format nil " and KCUILRL <= ~d" srl)))
+      (awhen (car (mutex-sql-query ls))
+	     (destructuring-bind (cui pfstr lrl) it
+	       (make-instance 'ucon :cui (ensure-integer cui)
+			      :pfstr pfstr
+			      :lrl (ensure-integer lrl)))))))
 
 (defun find-ucon-str (str &key (srl *current-srl*))
   "Find ucon that are exact match for str"
-  (if str
-      (let ((ucons '())
-	    (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where STR='~a'" str)))
-	(when srl
-	    (string-append ls " and KCUILRL <= ~d" srl))
-	(dolist (tuple (mutex-sql-query ls))
-	  (push (make-instance 'ucon :cui (ensure-integer (nth 0 tuple)) 
-			       :pfstr (nth 1 tuple)
-			       :lrl (ensure-integer (nth 2 tuple))) ucons))
-	(nreverse ucons))
-    nil))
+  (when str
+    (let ((ucons '())
+	  (ls (format nil "select distinct CUI,KPFSTR,KCUILRL from MRCON where STR='~a'" str)))
+      (when srl
+	(string-append ls " and KCUILRL <= ~d" srl))
+      (dolist (tuple (mutex-sql-query ls))
+	(destructuring-bind (cui pfstr lrl) tuple
+	  (push (make-instance 'ucon :cui (ensure-integer cui) 
+			       :pfstr pfstr
+			       :lrl (ensure-integer lrl))
+		ucons)))
+	(nreverse ucons))))
 
 (defun find-ucon-all (&key (srl *current-srl*))
   "Return list of all ucon's"
@@ -208,7 +166,8 @@
     (when srl
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'udef :sab (car tuple) :def (cadr tuple)) udefs))
+      (destructuring-bind (sab def) tuple
+	(push (make-instance 'udef :sab sab :def def) udefs)))
     (nreverse udefs)))
 
 (defun find-usty-cui (cui &key (srl *current-srl*))
@@ -218,7 +177,8 @@
     (when srl
 	(string-append ls (format nil " and KLRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'usty :tui (ensure-integer (car tuple)) :sty (cadr tuple)) ustys))
+      (destructuring-bind (tui sty) tuple
+	(push (make-instance 'usty :tui (ensure-integer tui) :sty sty) ustys)))
     ustys))
 
 (defun find-usty-word (word &key (srl *current-srl*))
@@ -228,7 +188,8 @@
     (when srl
 	(string-append ls (format nil " and KLRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'usty :tui (ensure-integer (car tuple)) :sty (cadr tuple)) ustys))
+      (destructuring-bind (tui sty) tuple
+	(push (make-instance 'usty :tui (ensure-integer tui) :sty sty) ustys)))
     ustys))
 
 (defun find-urel-cui (cui &key (srl *current-srl*))
@@ -238,16 +199,17 @@
     (when srl
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'urel 
-	      :cui1 cui
-	      :rel (nth 0 tuple) 
-	      :cui2 (ensure-integer (nth 1 tuple))
-	      :rela (nth 2 tuple)
-	      :sab (nth 3 tuple)
-	      :sl (nth 4 tuple)
-	      :mg (nth 5 tuple)
-	      :pfstr2 (nth 6 tuple))
-	    urels))
+      (destructuring-bind (rel cui2 rela sab sl mg pfstr2) tuple
+	(push (make-instance 'urel 
+			     :cui1 cui
+			     :rel rel
+			     :cui2 (ensure-integer cui2)
+			     :rela rela
+			     :sab sab
+			     :sl sl
+			     :mg mg
+			     :pfstr2 pfstr2)
+	      urels)))
     (nreverse urels)))
 
 (defun find-urel-cui2 (cui2 &key (srl *current-srl*))
@@ -257,16 +219,17 @@
     (when srl
 	(string-append ls (format nil " and SRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'urel 
-	      :cui2 cui2
-	      :rel (nth 0 tuple) 
-	      :cui1 (ensure-integer (nth 1 tuple))
-	      :rela (nth 2 tuple)
-	      :sab (nth 3 tuple)
-	      :sl (nth 4 tuple)
-	      :mg (nth 5 tuple)
-	      :pfstr2 (nth 6 tuple))
-	    urels))
+      (destructuring-bind (rel cui1 rela sab sl mg pfstr2) tuple
+	(push (make-instance 'urel 
+			     :cui2 cui2
+			     :rel rel
+			     :cui1 (ensure-integer cui1)
+			     :rela rela
+			     :sab sab
+			     :sl sl
+			     :mg mg
+			     :pfstr2 pfstr2)
+	      urels)))
     (nreverse urels)))
 
 (defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
@@ -282,16 +245,16 @@
 	(string-append ls (format nil " and KLRL <= ~d" srl)))
     (string-append ls " order by COF asc")
     (dolist (tuple (mutex-sql-query ls))
-      (let ((cui2 (ensure-integer (nth 0 tuple))))
-	(when (zerop cui2)
-	  (setq cui2 nil))
+      (destructuring-bind (cui2 soc cot cof coa pfstr2) tuple
+	(setq cui2 (ensure-integer cui2))
+	(when (zerop cui2) (setq cui2 nil))
 	(push (make-instance 'ucoc :cui1 cui
 			     :cui2 cui2
-			     :soc (nth 1 tuple)
-			     :cot (nth 2 tuple)
-			     :cof (ensure-integer (nth 3 tuple))
-			     :coa (nth 4 tuple)
-			     :pfstr2 (nth 5 tuple))
+			     :soc soc
+			     :cot cot
+			     :cof (ensure-integer cof)
+			     :coa coa
+			     :pfstr2 pfstr2)
 	      ucocs)))
     ucocs)) ;; akready ordered by SQL select
 
@@ -303,14 +266,15 @@
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (string-append ls " order by COF asc")
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'ucoc :cui1 (ensure-integer (nth 0 tuple))
-			   :cui2 cui2
-			   :soc (nth 1 tuple)
-			   :cot (nth 2 tuple)
-			   :cof (ensure-integer (nth 3 tuple))
-			   :coa (nth 4 tuple)
-			   :pfstr2 (nth 5 tuple))
-	    ucocs))
+      (destructuring-bind (cui1 soc cot cof coa pfstr2) tuple
+	(push (make-instance 'ucoc :cui1 (ensure-integer cui1)
+			     :cui2 cui2
+			     :soc soc
+			     :cot cot
+			     :cof (ensure-integer cof)
+			     :coa coa
+			     :pfstr2 pfstr2)
+	      ucocs)))
     ucocs)) ;; already ordered by SQL select
 
 (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
@@ -326,13 +290,14 @@
     (when srl
 	(string-append ls (format nil " and KLRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'ulo :isn (nth 0 tuple) 
-			   :fr (ensure-integer (nth 1 tuple))
-			   :un (nth 2 tuple)
-			   :sui (ensure-integer (nth 3 tuple))
-			   :sna (nth 4 tuple)
-			   :soui (nth 5 tuple))
-	    ulos))
+      (destructuring-bind (isn fr un sui sna soui) tuple
+	(push (make-instance 'ulo :isn isn
+			     :fr (ensure-integer fr)
+			     :un un
+			     :sui (ensure-integer sui)
+			     :sna sna
+			     :soui soui)
+	      ulos)))
     (nreverse ulos)))
 
 (defgeneric suistr (lo))
@@ -347,10 +312,8 @@
     (when srl
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'uatx :sab (nth 0 tuple) 
-			   :rel (nth 1 tuple)
-			   :atx (nth 2 tuple))
-	    uatxs))
+      (destructuring-bind (sab rel atx) tuple
+	(push (make-instance 'uatx :sab sab :rel rel :atx atx) uatxs)))
     (nreverse uatxs)))
 
 
@@ -361,12 +324,10 @@
     (when srl
 	(string-append ls (format nil " and KLUILRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'uterm :lui (ensure-integer (nth 0 tuple))
-			   :cui cui
-			   :lat (nth 1 tuple)
-			   :ts (nth 2 tuple)
-			   :lrl (ensure-integer (nth 3 tuple)))
-	uterms))
+      (destructuring-bind (lui lat ts lrl) tuple
+	(push (make-instance 'uterm :lui (ensure-integer lui) :cui cui
+			     :lat lat :ts ts :lrl (ensure-integer lrl))
+	      uterms)))
     (nreverse uterms)))
 
 (defun find-uterm-lui (lui &key (srl *current-srl*))
@@ -378,61 +339,47 @@
     (when srl
 	(string-append ls (format nil " and KLUILRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'uterm :cui (ensure-integer (nth 0 tuple))
-			   :lui lui
-			   :lat (nth 1 tuple)
-			   :ts (nth 2 tuple)
-			   :lrl (ensure-integer (nth 3 tuple)))
-	    uterms))
+      (destructuring-bind (cui lat ts lrl) tuple
+	(push (make-instance 'uterm :cui (ensure-integer cui) :lui lui
+			     :lat lat :ts ts :lrl (ensure-integer lrl))
+	      uterms)))
     (nreverse uterms)))
 
 (defun find-uterm-cuilui (cui lui &key (srl *current-srl*))
   "Return single uterm for cui/lui"
   (let ((ls (format nil "select LAT,TS,KLUILRL from MRCON where KCUILUI=~d limit 1" (make-cuilui cui lui))))
-    (when srl
-	(string-append ls (format nil " and KLUILRL <= ~d" srl)))
-    (kmrcl:aif (car (mutex-sql-query ls))
-	 (make-instance 'uterm :cui cui
-			:lui lui
-			:lat (nth 0 kmrcl::it)
-		       :ts (nth 1 kmrcl::it)
-		       :lrl (ensure-integer (nth 2 kmrcl::it)))
-	 nil)))
+    (when srl (string-append ls (format nil " and KLUILRL <= ~d" srl)))
+    (awhen (car (mutex-sql-query ls))
+	   (destructuring-bind (lat ts lrl) it
+	     (make-instance 'uterm :cui cui :lui lui :lat lat :ts ts 
+			    :lrl (ensure-integer lrl))))))
 
 (defun find-ustr-cuilui (cui lui &key (srl *current-srl*))
   "Return a list of ustr for cui/lui"
   (declare (fixnum cui lui))
   (let ((ustrs '())
 	(ls (format nil "select SUI,STT,STR,LRL from MRCON where KCUILUI=~d" (make-cuilui cui lui))))
-    (when srl
-	(string-append ls (format nil " and LRL <= ~d" srl)))
+    (when srl (string-append ls (format nil " and LRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (let* ((sui (ensure-integer (car tuple)))
-	     (ustr (make-instance 'ustr :sui sui
-				  :cui cui
-				  :cuisui (make-cuisui cui sui)
-				  :lui lui
-				  :stt (nth 1 tuple)
-				  :str (nth 2 tuple)
-				  :lrl (ensure-integer (nth 3 tuple)))))
-	(push ustr ustrs)))
+      (destructuring-bind (sui stt str lrl) tuple
+	(push
+	 (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui
+			:cuisui (make-cuisui cui sui) :stt stt :str str
+			:lrl (ensure-integer lrl))
+	 ustrs)))
     (nreverse ustrs)))
 
 (defun find-ustr-cuisui (cui sui &key (srl *current-srl*))
   "Return the single ustr for cuisui"
   (let ((ls (format nil "select LUI,STT,STR,LRL from MRCON where KCUISUI=~d"
 		    (make-cuisui cui sui))))
-    (when srl
-	(string-append ls (format nil " and LRL <= ~d" srl)))
-    (kmrcl:aif (car (mutex-sql-query ls))
-	 (make-instance 'ustr :sui sui 
-			:cui cui
-			:cuisui (make-cuisui cui sui)
-			:lui (ensure-integer (nth 0 kmrcl::it))
-			:stt (nth 1 kmrcl::it)
-			:str (nth 2 kmrcl::it)
-			:lrl (ensure-integer (nth 3 kmrcl::it)))
-	 nil)))
+    (when srl (string-append ls (format nil " and LRL <= ~d" srl)))
+    (awhen (car (mutex-sql-query ls))
+	   (destructuring-bind (lui stt str lrl) it
+	     (make-instance 'ustr :sui sui :cui cui
+			    :cuisui (make-cuisui cui sui)
+			    :lui (ensure-integer lui) :stt stt :str str
+			    :lrl (ensure-integer lrl))))))
 
 (defun find-ustr-sui (sui &key (srl *current-srl*))
   "Return the list of ustr for sui"
@@ -440,18 +387,15 @@
       (setq sui (parse-sui sui)))
   (let ((ustrs '())
 	(ls (format nil "select CUI,LUI,STT,STR,LRL from MRCON where SUI=~d" sui)))
-    (when srl
-	(string-append ls (format nil " and LRL <= ~d" srl)))
+    (when srl (string-append ls (format nil " and LRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (let ((cui (ensure-integer (car tuple))))
-	(push (make-instance 'ustr :sui sui 
-			     :cui cui
+      (destructuring-bind (cui lui stt str lrl) tuple
+	(setq cui (ensure-integer cui))
+	(push (make-instance 'ustr :sui sui :cui cui :stt stt :str str
 			     :cuisui (make-cuisui cui sui)
-			     :lui (ensure-integer (nth 1 tuple))
-			     :stt (nth 2 tuple)
-			     :str (nth 3 tuple)
-			     :lrl (ensure-integer (nth 4 tuple)))
-	ustrs)))
+			     :lui (ensure-integer lui)
+			     :lrl (ensure-integer lrl))
+	      ustrs)))
     (nreverse ustrs)))
       
 (defun find-ustr-sab (sab &key (srl *current-srl*))
@@ -509,9 +453,9 @@
     (when srl
 	(string-append ls (format nil " and SRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'uso :sab (nth 0 tuple) :code (nth 1 tuple) 
-			   :srl (nth 2 tuple) :tty (nth 3 tuple))
-	    usos))
+      (destructuring-bind (sab code srl tty) tuple
+	(push (make-instance 'uso :sab sab :code code :srl srl :tty tty)
+	      usos)))
     (nreverse usos)))
 
 (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*))
@@ -522,17 +466,14 @@
     (when srl
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'ucxt :sab (nth 0 tuple) 
-			   :code (nth 1 tuple) 
-			   :cxn (ensure-integer (nth 2 tuple))
-			   :cxl (nth 3 tuple)
-			   :rnk (ensure-integer (nth 4 tuple))
-			   :cxs (nth 5 tuple)
-			   :cui2 (ensure-integer (nth 6 tuple))
-			   :hcd (nth 7 tuple)
-			   :rela (nth 8 tuple)
-			   :xc (nth 9 tuple))
-	    ucxts))
+      (destructuring-bind (sab code cxn cxl rnk cxs cui2 hcd rela xc) tuple
+	(push (make-instance 'ucxt :sab sab :code 
+			     :cxn (ensure-integer cxn)
+			     :cxl cxl :cxs cxs :hcd hcd :rela rela :xc xc
+			     :code code
+			     :rnk (ensure-integer rnk)
+			     :cui2 (ensure-integer cui2))
+	      ucxts)))
     (nreverse ucxts)))
 
 (defun find-usat-ui (cui &optional (lui nil) (sui nil) &key (srl *current-srl*))
@@ -545,11 +486,9 @@
 	(string-append ls (format nil " and KSRL <= ~d" srl)))
     (let ((usats '()))
       (dolist (tuple (mutex-sql-query ls))
-	(push (make-instance 'usat :code (nth 0 tuple)
-			     :atn (nth 1 tuple)
-			     :sab (nth 2 tuple)
-			     :atv (nth 3 tuple))
-	      usats))
+	(destructuring-bind (code atn sab atv) tuple
+	  (push (make-instance 'usat :code code :atn atn :sab sab :atv atv)
+		usats)))
       (nreverse usats))))
 
 
@@ -559,17 +498,15 @@
 (defun find-usty-tui (tui)
   "Find usty for tui"
   (setq tui (parse-tui tui)) 
-    (kmrcl:aif (car (mutex-sql-query 
+  (awhen (car (mutex-sql-query 
 	       (format nil "select STY from MRSTY where TUI=~d limit 1" tui)))
-	 (make-instance 'usty :tui tui :sty (nth 0 kmrcl::it))
-	 nil))
+	 (make-instance 'usty :tui tui :sty (car it))))
 
 (defun find-usty-sty (sty)
   "Find usty for a sty"
-  (kmrcl:aif (car (mutex-sql-query 
-		(format nil "select TUI from MRSTY where STY='~a' limit 1" sty)))
-	  (make-instance 'usty :tui (ensure-integer (nth 0 kmrcl::it)) :sty sty)
-	  nil))
+  (awhen (car (mutex-sql-query 
+	       (format nil "select TUI from MRSTY where STY='~a' limit 1" sty)))
+	 (make-instance 'usty :tui (ensure-integer (car it)) :sty sty)))
 
 (defun find-usty-all ()
   "Return list of usty's for all semantic types"
@@ -627,12 +564,10 @@
 
 (defun find-ucon-tui (tui &key (srl *current-srl*))
   "Find list of ucon for tui"
-  (when (stringp tui)
-      (setq tui (parse-tui tui)))
+  (when (stringp tui) (setq tui (parse-tui tui)))
   (let ((ucons '())
 	(ls (format nil "select CUI from MRSTY where TUI=~d" tui)))
-    (when srl
-	(string-append ls (format nil " and KLRL <= ~d" srl)))
+    (when srl (string-append ls (format nil " and KLRL <= ~d" srl)))
     (string-append ls " order by cui desc")
     (dolist (tuple (mutex-sql-query ls))
       (push (find-ucon-cui (ensure-integer (car tuple)) :srl srl) ucons))
@@ -644,8 +579,7 @@
 	(ls (format nil "select distinct cui from MRXW_ENG where wd~A'~A'" 
 		    (if like " LIKE " "=") 
 		    word)))
-    (when srl
-      (string-append ls (format nil " and KLRL <= ~d" srl)))
+    (when srl (string-append ls (format nil " and KLRL <= ~d" srl)))
     (string-append ls " order by cui desc")
     (dolist (tuple (mutex-sql-query ls))
       (push (find-ucon-cui (car tuple) :srl srl) ucons))
@@ -657,8 +591,7 @@
 	(ls (format nil "select distinct cui from MRXNW_ENG where nwd~A'~A'" 
 		    (if like " LIKE " "=")
 		    word)))
-    (when srl
-      (string-append ls (format nil " and KLRL <= ~d" srl)))
+    (when srl (string-append ls (format nil " and KLRL <= ~d" srl)))
     (string-append ls " order by cui desc")
     (dolist (tuple (mutex-sql-query ls))
       (push (find-ucon-cui (car tuple) :srl srl) ucons))
@@ -668,12 +601,13 @@
   "Return list of ustrs that match word"
   (let ((ustrs '())
 	(ls (format nil "select cui,sui from MRXW_ENG where wd='~a'" word)))
-    (when srl
-	(string-append ls (format nil " and KLRL <= ~d" srl)))
+    (when srl (string-append ls (format nil " and KLRL <= ~d" srl)))
     (string-append ls " order by cui desc,sui desc")
     (dolist (tuple (mutex-sql-query ls))
-      (push (find-ustr-cuisui (ensure-integer (car tuple)) (ensure-integer (cadr tuple)) :srl srl)
-	    ustrs))
+      (destructuring-bind (cui sui) tuple
+	(push (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui)
+				:srl srl)
+	      ustrs)))
     ustrs))
 
 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
@@ -684,8 +618,10 @@
 	(string-append ls (format nil " and KLRL <= ~d" srl)))
     (string-append ls " order by cui desc,sui desc")
     (dolist (tuple (mutex-sql-query ls))
-      (push (find-ustr-cuisui (ensure-integer (car tuple)) (ensure-integer (cadr tuple)) :srl srl)
-	    ustrs))
+      (destructuring-bind (cui sui) tuple
+	(push (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui)
+				:srl srl)
+	      ustrs)))
     ustrs))
 
 ;; Special tables
@@ -694,8 +630,8 @@
   (let ((usrls '())
 	(tuples (mutex-sql-query "select SAB,SRL from USRL order by SAB desc")))
     (dolist (tuple tuples)
-      (push (make-instance 'usrl :sab (nth 0 tuple)
-			   :srl (ensure-integer (nth 1 tuple))) usrls))
+      (destructuring-bind (sab srl) tuple
+	(push (make-instance 'usrl :sab sab :srl (ensure-integer srl)) usrls)))
     usrls))
 
 ;;; Multiword lookup and score functions
@@ -771,287 +707,219 @@
 ;;; LEX SQL functions
 
 (defun find-lexterm-eui (eui)
-  (kmrcl:awhen (car (mutex-sql-query
-		  (format nil "select WRD from LRWD where EUI=~d" eui)))
-	    (make-instance 'lexterm :eui eui :wrd (nth 0 kmrcl:it))))
+  (awhen (car (mutex-sql-query
+	       (format nil "select WRD from LRWD where EUI=~d" eui)))
+	    (make-instance 'lexterm :eui eui :wrd (car it))))
 
 (defun find-lexterm-word (wrd)
-  (kmrcl:awhen (mutex-sql-query
-	     (format nil "select EUI from LRWD where WRD='~a'" wrd))
-	    (let ((terms '()))
-	      (dolist (tuple kmrcl:it)
-		(let ((eui (ensure-integer (nth 0 tuple))))
-		  (push
-		   (make-instance 'lexterm :eui eui :wrd (copy-seq wrd))
-		   terms)))
-	      (nreverse terms))))
-
-;; LEXTERM accessors, read on demand
-	      
-(def-lazy-reader lexterm s#abr find-labr-eui eui)
-(def-lazy-reader lexterm s#agr find-lagr-eui eui)
-(def-lazy-reader lexterm s#cmp find-lcmp-eui eui)
-(def-lazy-reader lexterm s#mod find-lmod-eui eui)
-(def-lazy-reader lexterm s#nom find-lnom-eui eui)
-(def-lazy-reader lexterm s#prn find-lprn-eui eui)
-(def-lazy-reader lexterm s#prp find-lprp-eui eui)
-(def-lazy-reader lexterm s#spl find-lspl-eui eui)
-(def-lazy-reader lexterm s#trm find-ltrm-eui eui)
-(def-lazy-reader lexterm s#typ find-ltyp-eui eui)
+  (let ((tuples (mutex-sql-query
+		 (format nil "select EUI from LRWD where WRD='~a'" wrd)))
+	(terms '()))
+    (dolist (tuple tuples)
+      (push (make-instance 'lexterm :eui (ensure-integer (car tuple))
+			   :wrd (copy-seq wrd))
+	    terms))
+    (nreverse terms)))
 
 ;; LEX SQL Read functions
 
 (defun find-labr-eui (eui)
-    (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,ABR,EUI2,BAS2 from LRABR where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'labr :eui eui 
-				  :bas (nth 0 tuple) 
-				  :abr (nth 1 tuple)
-				  :eui2 (ensure-integer (nth 2 tuple))
-				  :bas2 (nth 3 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil "select BAS,ABR,EUI2,BAS2 from LRABR where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas abr eui2 bas2) tuple
+	(push (make-instance 'labr :eui eui :bas bas :abr abr :bas2 bas2
+			     :eui2 (ensure-integer eui2))
+	      results)))
+    (nreverse results)))
 
 (defun find-labr-bas (bas)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select EUI,ABR,EUI2,BAS2 from LRABR where BAS='~a'" bas))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'labr :eui (ensure-integer (nth 0 tuple))
-				  :bas (copy-seq bas)
-				  :abr (nth 1 tuple)
-				  :eui2 (ensure-integer (nth 2 tuple))
-				  :bas2 (nth 3 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil "select EUI,ABR,EUI2,BAS2 from LRABR where BAS='~a'"
+		  bas)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (eui abr eui2 bas2) tuple 
+	(push
+	 (make-instance 'labr :eui (ensure-integer eui) :abr abr :bas2 bas2
+			:bas (copy-seq bas) :eui2 (ensure-integer eui2))
+	 results)))
+    (nreverse results)))
 
 (defun find-lagr-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select STR,SCA,AGR,CIT,BAS from LRAGR where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lagr 
-				  :eui eui
-				  :str (nth 0 tuple)
-				  :sca (nth 1 tuple)
-				  :agr (nth 2 tuple)
-				  :cit (nth 3 tuple)
-				  :bas (nth 4 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil "select STR,SCA,AGR,CIT,BAS from LRAGR where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (str sca agr cit bas) tuple
+	(push (make-instance 'lagr :eui eui :str str :sca sca :agr agr :
+			     cit cit :bas bas)
+	      results)))
+    (nreverse results)))
 
 (defun find-lcmp-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,SCA,COM from LRCMP where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lcmp
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :sca (nth 1 tuple)
-				  :com (nth 2 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select BAS,SCA,COM from LRCMP where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas sca com) tuple
+	(push (make-instance 'lcmp :eui eui :bas bas :sca sca :com com)
+	      results)))
+    (nreverse results)))
 
 (defun find-lmod-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,SCA,PSN_MOD,FEA from LRMOD where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lmod
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :sca (nth 1 tuple)
-				  :psnmod (nth 2 tuple)
-				  :fea (nth 3 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil
+		  "select BAS,SCA,PSN_MOD,FEA from LRMOD where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas sca psnmod fea) tuple
+	(push (make-instance 'lmod :eui eui :bas bas :sca sca :psnmod psnmod
+			     :fea fea)
+	      results)))
+    (nreverse results)))
 
 (defun find-lnom-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,SCA,EUI2,BAS2,SCA2 from LRNOM where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lnom
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :sca (nth 1 tuple)
-				  :eui2 (ensure-integer (nth 2 tuple))
-				  :bas2 (nth 3 tuple)
-				  :sca2 (nth 4 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format
+	   nil "select BAS,SCA,EUI2,BAS2,SCA2 from LRNOM where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas sca eui2 bas2 sca2) tuple
+	(push
+	 (make-instance 'lnom :eui eui :bas bas :sca sca :bas2 bas2 :sca2 sca2
+			:eui2 (ensure-integer eui2))
+	 results)))
+    (nreverse results)))
 
 (defun find-lprn-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,NUM,GND,CAS,POS,QNT,FEA from LRPRN where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lprn
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :num (nth 1 tuple)
-				  :gnd (nth 2 tuple)
-				  :cas (nth 3 tuple)
-				  :pos (nth 4 tuple)
-				  :qnt (nth 5 tuple)
-				  :fea (nth 6 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format
+	   nil
+	   "select BAS,NUM,GND,CAS,POS,QNT,FEA from LRPRN where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas num gnd cas pos qnt fea) tuple
+	(push (make-instance 'lprn :eui eui :bas bas :num num :gnd gnd
+			     :cas cas :pos pos :qnt qnt :fea fea)
+	      results)))
+    (nreverse results)))
 
 (defun find-lprp-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,STR,SCA,FEA from LRPRP where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lprp
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :str (nth 1 tuple)
-				  :sca (nth 2 tuple)
-				  :fea (nth 3 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil "select BAS,STR,SCA,FEA from LRPRP where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas str sca fea) tuple
+	(push
+	 (make-instance 'lprp :eui eui :bas bas :str str :sca sca :fea fea)
+	 results)))
+    (nreverse results)))
 
 (defun find-lspl-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select SPV,BAS from LRSPL where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'lspl
-				  :eui eui
-				  :spv (nth 0 tuple)
-				  :bas (nth 1 tuple))
-		   results))
-		(nreverse results))))
-
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select SPV,BAS from LRSPL where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (spv bas) tuple
+	(push (make-instance 'lspl :eui eui :spv spv :bas bas) results)))
+    (nreverse results)))
 
 (defun find-ltrm-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,GEN from LRTRM where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'ltrm
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :gen (nth 1 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select BAS,GEN from LRTRM where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas gen) tuple
+	(push (make-instance 'ltrm :eui eui :bas bas :gen gen) results)))
+    (nreverse results)))
 
 (defun find-ltyp-eui (eui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select BAS,SCA,TYP from LRTYP where EUI=~d" eui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'ltyp
-				  :eui eui
-				  :bas (nth 0 tuple)
-				  :sca (nth 1 tuple)
-				  :typ (nth 2 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select BAS,SCA,TYP from LRTYP where EUI=~d" eui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (bas sca typ) tuple
+	  (push (make-instance 'ltyp :eui eui :bas bas :sca sca :typ typ)
+		results)))
+    (nreverse results)))
 
 (defun find-lwd-wrd (wrd)
-  (kmrcl:awhen (mutex-sql-query 
-	     (format nil "select EUI from LRWD where WRD='~a'" wrd))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push (ensure-integer (nth 0 tuple)) results))
-		(make-instance 'lwd :wrd wrd
-			       :euilist (nreverse results)))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select EUI from LRWD where WRD='~a'" wrd)))
+	(results '()))
+    (dolist (tuple tuples)
+      (push (ensure-integer (car tuple)) results))
+    (make-instance 'lwd :wrd wrd :euilist (nreverse results))))
 
 ;;; Semantic Network SQL access functions
  
 (defun find-sdef-ui (ui)
-  (kmrcl:awhen (car (mutex-sql-query 
+  (awhen (car (mutex-sql-query 
 		  (format nil "select RT,STY_RL,STN_RTN,DEF,EX,UN,RH,ABR,RIN from SRDEF where UI=~d" ui)))
-	    (make-instance 'sdef :rt (nth 0 kmrcl::it)
-			   :ui ui
-			   :styrl (nth 1 kmrcl::it)
-			   :stnrtn (nth 2 kmrcl::it)
-			   :def (nth 3 kmrcl::it)
-			   :ex (nth 4 kmrcl::it)
-			   :un (nth 5 kmrcl::it)
-			   :rh (nth 6 kmrcl::it)
-			   :abr (nth 7 kmrcl::it)
-			   :rin (nth 8 kmrcl::it))))
+	 (destructuring-bind (rt styrl stnrtn def ex un rh abr rin) it
+	   (make-instance 'sdef :rt rt :ui ui :styrl styrl :stnrtn stnrtn
+			   :def def :ex ex :un un :rh rh :abr abr :rin rin))))
 
 (defun find-sstre1-ui (ui)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select UI2,UI3 from SRSTRE1 where UI=~d" ui))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'sstre1 :ui ui
-				  :ui2 (ensure-integer (nth 0 tuple))
-				  :ui3 (ensure-integer (nth 1 tuple)))
-		   results))
-		(nreverse results))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select UI2,UI3 from SRSTRE1 where UI=~d" ui)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (ui2 ui3) tuple
+	(push (make-instance 'sstre1 :ui ui :ui2 (ensure-integer ui2)
+			     :ui3 (ensure-integer ui3))
+	      results)))
+    (nreverse results)))
 
 (defun find-sstre1-ui2 (ui2)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select UI,UI3 from SRSTRE1 where UI2=~d" ui2))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'sstre1 :ui (ensure-integer (nth 0 tuple))
-				  :ui2 ui2
-				  :ui3 (ensure-integer (nth 1 tuple)))
-		   results))
-		(nreverse results))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select UI,UI3 from SRSTRE1 where UI2=~d" ui2)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (ui ui3) tuple
+	(push (make-instance 'sstre1 :ui (ensure-integer ui) :ui2 ui2
+			     :ui3 (ensure-integer ui3))
+	      results)))
+    (nreverse results)))
 
 (defun find-sstr-rl (rl)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select STY_RL,STY_RL2,LS from SRSTRE where RL='~a'" rl))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'sstr 
-				  :rl rl
-				  :styrl (nth 0 tuple)
-				  :styrl2 (nth 1 tuple)
-				  :ls (nth 2 tuple))
-		   results))
-		(nreverse results))))
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil "select STY_RL,STY_RL2,LS from SRSTRE where RL='~a'" rl)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (styrl styrl2 ls) tuple
+	(push (make-instance 'sstr :rl rl :styrl styrl :styrl2 styrl2 :ls ls)
+	      results)))
+    (nreverse results)))
 
 
 (defun find-sstre2-sty (sty)
-  (kmrcl:awhen (mutex-sql-query 
-	     (format nil "select RL,STY2 from SRSTRE2 where STY='~a'" sty))
-	    (let ((results '()))
-	      (dolist (tuple kmrcl::it)
-		(push
-		 (make-instance 'sstre2
-				:sty (copy-seq sty)
-				:rl (nth 0 tuple)
-				:sty2 (nth 1 tuple))
-				results))
-		(nreverse results))))
+  (let ((tuples (mutex-sql-query 
+		 (format nil "select RL,STY2 from SRSTRE2 where STY='~a'" sty)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (rl sty2) tuple
+	(push (make-instance 'sstre2 :sty (copy-seq sty) :rl rl :sty2 sty2)
+	      results)))
+    (nreverse results)))
 
 (defun find-sstr-styrl (styrl)
-  (kmrcl:awhen (mutex-sql-query 
-	       (format nil "select RL,STY_RL2,LS from SRSTR where RL='~a'" styrl))
-	      (let ((results '()))
-		(dolist (tuple kmrcl::it)
-		  (push
-		   (make-instance 'sstr :styrl styrl
-				  :rl (nth 0 tuple)
-				  :styrl2 (nth 1 tuple)
-				  :ls (nth 2 tuple))
-		   results))
-		(nreverse results))))
-
-
+  (let ((tuples
+	 (mutex-sql-query 
+	  (format nil "select RL,STY_RL2,LS from SRSTR where RL='~a'" styrl)))
+	(results '()))
+    (dolist (tuple tuples)
+      (destructuring-bind (rl styrl2 ls) tuple
+      (push (make-instance 'sstr :styrl styrl :rl rl :styrl2 styrl2 :ls ls)
+	    results)))
+    (nreverse results)))