- (when where-value
- (mutex-sql-query
- (query-string table fields srl where-name where-value lrlname final))))
-
-
-(defun query-string (table fields &optional srl where-name where-value
- (lrlname "KCUILRL") final)
- (let ((qs (format nil "select ~{~:@(~A~)~^,~} from ~:@(~A~)" fields table)))
- (when where-name
- (setq qs (concatenate 'string qs
- (format nil
- (if (stringp where-value)
- " where ~A='~A'"
- " where ~A=~A")
- where-name where-value))))
- (when srl
- (setq qs (concatenate 'string qs (format nil " and ~:@(~A~) <= ~D"
- lrlname srl))))
- (when final
- (setq qs (concatenate 'string qs " " final)))
- qs))
-
-(defun find-ucon-cui (cui &key (srl *current-srl*))
- "Find ucon for a cui"
- (loop
- (for tuple in (umlisp-query 'mrcon '(kpfstr kcuilrl) srl
- 'cui (parse-cui cui) :final "limit 1")
- collect
- (make-instance 'ucon :cui (parse-cui cui)
- :pfstr (car tuple)
- :lrl (ensure-integer (cadr tuple))))))
-
-(defun find-ucon-cui-old (cui &key (srl *current-srl*))
- "Find ucon for a cui"
- (when (stringp cui) (setq cui (parse-cui cui)))
- (when cui
- (let ((ls
- (maybe-add-srl
- (format nil "select KPFSTR,KCUILRL from MRCON where CUI=~d" cui)
- srl :final "limit 1")))
- (awhen (car (mutex-sql-query ls))
- (make-instance 'ucon :cui cui :pfstr (car it)
- :lrl (ensure-integer (cadr it)))))))
-
-(defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*))
- "Find ucon for a cui"
- (when (stringp cui) (setq cui (parse-cui cui)))
+ `(,query-cmd
+ (query-string ,table ,fields ,srl ,where-name ,where-value
+ :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
+ :filter ,filter :limit ,limit)))
+
+(defmacro umlisp-query-eval (table fields srl where-name where-value
+ &key (lrl "KCUILRL") single distinct order like
+ filter limit)
+ "Query the UMLisp database. Return a list of umlisp objects whose name
+is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
+ `(mutex-sql-query
+ (query-string-eval ,table ,fields ,srl ,where-name ,where-value
+ :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
+ :filter ,filter :limit ,limit)))
+
+;; only WHERE-VALUE and SRL are evaluated
+(defmacro collect-umlisp-query ((table fields srl where-name where-value
+ &key (lrl "KCUILRL") distinct single
+ order like (query-cmd 'mutex-sql-query)
+ filter limit)
+ &body body)
+ (let ((value (gensym))
+ (r (gensym)))
+ (if single
+ (if (and limit (> limit 1))
+ (error "Can't set limit along with single.")
+ `(let* ((,value ,where-value)
+ (tuple (car (umlisp-query ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single
+ :distinct ,distinct :order ,order
+ :like ,like :filter ,filter
+ :query-cmd ,query-cmd))))
+ ,@(unless where-name `((declare (ignore ,value))))
+ (when tuple
+ (destructuring-bind ,fields tuple
+ ,@body))))
+ `(let ((,value ,where-value))
+ ,@(unless where-name `((declare (ignore ,value))))
+ (let ((,r '()))
+ (dolist (tuple (umlisp-query ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :filter ,filter :like ,like
+ :limit ,limit))
+ (push (destructuring-bind ,fields tuple ,@body) ,r))
+ (nreverse ,r))
+ #+ignore
+ (loop for tuple in
+ (umlisp-query ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like :filter ,filter :limit ,limit)
+ collect (destructuring-bind ,fields tuple ,@body))))))
+
+(defmacro collect-umlisp-query-eval ((table fields srl where-name where-value
+ &key (lrl "KCUILRL") distinct single
+ order like filter limit)
+ &body body)
+ (let ((value (gensym))
+ (r (gensym))
+ (eval-fields (cadr fields)))
+ (if single
+ `(let* ((,value ,where-value)
+ (tuple (car (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single
+ :distinct ,distinct :order ,order
+ :like ,like :filter ,filter
+ :limit ,limit))))
+ (when tuple
+ (destructuring-bind ,eval-fields tuple
+ ,@body)))
+ `(let ((,value ,where-value)
+ (,r '()))
+ (dolist (tuple (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like
+ :filter ,filter :limit ,limit))
+ (push (destructuring-bind ,eval-fields tuple ,@body) ,r))
+ (nreverse ,r)
+ #+ignore
+ (loop for tuple in
+ (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like :filter ,filter
+ :limit ,limit)
+ collect (destructuring-bind ,eval-fields tuple ,@body))))))
+
+;;;
+;;; Read from SQL database
+
+(defmacro ensure-cui-integer (cui)
+ `(if (stringp ,cui)
+ (setq ,cui (parse-cui ,cui))
+ ,cui))
+
+(defmacro ensure-lui-integer (lui)
+ `(if (stringp ,lui)
+ (setq ,lui (parse-lui ,lui))
+ ,lui))
+
+(defmacro ensure-sui-integer (sui)
+ `(if (stringp ,sui)
+ (setq ,sui (parse-sui ,sui))
+ ,sui))
+
+(defmacro ensure-aui-integer (aui)
+ `(if (stringp ,aui)
+ (setq ,aui (parse-aui ,aui))
+ ,aui))
+
+(defmacro ensure-rui-integer (rui)
+ `(if (stringp ,rui)
+ (setq ,rui (parse-rui ,rui))
+ ,rui))
+
+(defmacro ensure-tui-integer (tui)
+ `(if (stringp ,tui)
+ (setq ,tui (parse-tui ,tui))
+ ,tui))
+
+(defmacro ensure-eui-integer (eui)
+ `(if (stringp ,eui)
+ (setq ,eui (parse-eui ,eui))
+ ,eui))
+
+(defun make-ucon-cui (cui)
+ (ensure-cui-integer cui)