private/utilities.ss
#lang scheme
;;; PLT Scheme Inference Collection
;;; utilities.ss
;;; Copyright (c) 2010, M. Douglas Williams
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;;; 02111-1307 USA.
;;;
;;; This module implements some small utilities to simplify interacting with the
;;; inference collection. Eventually, these should be part of the inference
;;; collection itself.

(require scheme/mpair
         "assertions.ss"
         "inference-control.ss")

;;; (sorted-query pattern) -> (listof assertion?)
;;;   pattern : pattern?
;;; Returns the results of a knowledge base query as an immutable list that is
;;; sorted by assertion-id. Therefore, the returned list list is chronologically
;;; ordered.
(define (sorted-query pattern)
  (sort (mlist->list (query pattern))
        (lambda (m1 m2)
          (< (assertion-id (car m1))
             (assertion-id (car m2))))))

;;; (query-values pattern) -> any
;;;   pattern : pattern?
;;; Returns the bindings for a query as multiple values. The query itself must
;;; return a single result; otherwise, an error is returned.
(define (query-values pattern)
  (let ((results (mlist->list (query pattern))))
    (unless (= (length results) 1)
      (error 'query-values
             "expected one result for ~s, got ~a"
             pattern (length results)))
    (apply
     values
     (for/list ((association (in-list (cdar results))))
       (cdr association)))))

;;; (in-query pattern) -> sequence?
;;; Returns a sequence of the bindings for a query.
(define (in-query pattern)
  (make-do-sequence
   (lambda ()
     (values
      (lambda (results)
        (apply
         values
         (for/list ((association (in-list (cdar results))))
           (cdr association))))
      cdr
      (sorted-query pattern)
      (lambda (results) (not (null? results)))
      (lambda v #t)
      (lambda (results . v) #t)))))

;;; Module Contracts

(provide (all-defined-out))