r4751: Auto commit for Debian build
authorKevin M. Rosenberg <kevin@rosenberg.net>
Sat, 3 May 2003 19:35:31 +0000 (19:35 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Sat, 3 May 2003 19:35:31 +0000 (19:35 +0000)
sql-classes.lisp

index 1fe072343fea69a3bd5ff641876acde8c494ccc5..a160c68ad0e894ea2af08e8e5b59e04b5da45771 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: sql-classes.lisp,v 1.24 2003/05/03 19:32:00 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.25 2003/05/03 19:35:31 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -72,13 +72,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
               where-name  where-value)
        "")
    (if srl (format nil " and ~:@(~A~) <= ~D" lrlname srl) "")
-   (if order
-       (format nil " order by ~{~:@(~A~) ~(~A~)~^,~}"
-              (flatten (loop for o in order collect
-                             (if (atom o)
-                                 (list o  'asc)
-                                 (list (car o) (cdr o))))))
-       "")
+   (if order (format nil " order by ~{~:@(~A~) ~(~A~)~^,~}" order) "")
    (if single " limit 1" "")))
 
 (defun find-ucon-cui (cui &key (srl *current-srl*))
@@ -152,7 +146,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                        :pfstr pfstr
                        :lrl (ensure-integer cuilrl)))
      (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil
-                  :order '((cui . asc)) :distinct t)
+                  :order '(cui asc) :distinct t)
      :database db)))
 
 (defun map-ucon-all (fn &key (srl *current-srl*))
@@ -165,7 +159,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                  (make-instance 'ucon :cui (ensure-integer cui)
                                 :pfstr pfstr
                                 :lrl (ensure-integer cuilrl))))
-     (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :order '((cui . asc)) :distinct t)
+     (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :order '(cui asc) :distinct t)
      :database db)))
 
 
@@ -204,7 +198,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucoc-cui (cui &key (srl *current-srl*))
   "Return a list of ucoc for cui"
   (with-umlisp-query ('mrcoc (cui2 soc cot cof coa kpfstr2) srl 'cui1 (parse-cui cui) 
-                            :lrlname "KSRL" :order '((cof . asc)))
+                            :lrlname "KSRL" :order '(cof asc))
     (setq cui2 (ensure-integer cui2))
     (when (zerop cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 (parse-cui cui) :cui2 (ensure-integer cui2) :soc soc :cot cot
@@ -213,7 +207,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*))
   "Return a list of ucoc for cui2"
   (with-umlisp-query ('mrcoc (cui1 soc cot cof coa kpfstr2) srl 'cui2 (parse-cui cui2) 
-                            :lrlname "KSRL" :order '((cof . asc)))
+                            :lrlname "KSRL" :order '(cof asc))
     (setq cui2 (ensure-integer cui2))
     (when (zerop cui2) (setq cui2 nil))
     (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 (parse-cui cui2) :soc soc :cot cot
@@ -310,7 +304,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                          :lrl lrl
                          :str pfstr))
        (query-string 'mrcon '(cui lui sui stt lrl kpfstr) srl nil nil :lrlname 'lrl :distinct t
-                    :order '((sui . asc)))
+                    :order '(sui asc))
        :database db)))
 
 (defun find-string-sui (sui &key (srl *current-srl*))
@@ -401,38 +395,39 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ucon-tui (tui &key (srl *current-srl*))
   "Find list of ucon for tui"
-  (with-umlisp-query ('mrsty (cui) srl 'tui (parse-tui tui) :lrlname 'klrl :order '((cui . asc)))
+  (with-umlisp-query ('mrsty (cui) srl 'tui (parse-tui tui) :lrlname 'klrl
+                            :order '(cui asc))
     (find-ucon-cui (ensure-integer cui) :srl srl)))
   
 (defun find-ucon-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word. Optionally, use SQL's LIKE syntax"
   (with-umlisp-query ('mrxw_eng (cui) srl 'wd word :like like :distinct t
-                               :lrlname 'klrl :order '((cui . asc)))
+                               :lrlname 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil))
   "Return list of ucons that match word, optionally use SQL's LIKE syntax"
   (with-umlisp-query ('mrxnw_eng (cui) srl 'nwd word :like like :distinct t
-                               :lrlname 'klrl :order '((cui . asc)))
+                               :lrlname 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
 (defun find-ustr-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"
   (with-umlisp-query ('mrxw_eng (cui sui) srl 'wd word
                                :lrlname 'klrl
-                               :order '((cui . asc) (sui . asc)))
+                               :order '(cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
 (defun find-ustr-normalized-word (word &key (srl *current-srl*))
   "Return list of ustrs that match word"
   (with-umlisp-query ('mrxnw_eng (cui sui) srl 'nwd word :lrlname 'klrl
-                                :order '((cui . asc) (sui . asc)))
+                                :order '(cui asc sui asc))
     (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl)))
 
 ;; Special tables
 
 (defun find-usrl-all ()
-  (with-umlisp-query ('usrl (sab srl) nil nil nil :order '((sab . asc)))
+  (with-umlisp-query ('usrl (sab srl) nil nil nil :order '(sab asc))
     (make-instance 'usrl :sab sab :srl (ensure-integer srl))))
 
 ;;; Multiword lookup and score functions