;;; -*- Mode: Lisp; Package: Prolog; Base: 10; Options: ((World System)) -*-
;;; (C) Copyright 1983,1984,1985, Uppsala University

;;Various top-levels for LM-Prolog.

(define-predicate print-and-space (:options (:world :system))
  ((print-and-space ?term)
   (lisp-command (FUNCALL (OR PRIN1 #'PRIN1) '?term) :invoke)
   (tyo #/  t)))

(define-predicate print-bindings (:options (:world :system))
  ((print-bindings ?variables ?values)
   (lisp-command (print-bindings '?variables '?values) :dont-invoke)))

(define-predicate variable-names (:options (:world :system))
  ((variable-names ?names ?term)
   (lisp-value ?names (nreverse (variable-names-in '?term)) :dont-invoke)))

;;This is the usual one.
(define-predicate :top-level-predication (:options (:world :ordinary-top-level))
  ((:top-level-predication ?predication)
   (cases ((atomic ?predication)
           (error ':bad-predication "~s must be a predication (i.e. a list)"
                  ?predication))
          ((variables ?variables ?predication)
	   (variable-names ?variable-names ?predication)
           (cases (?predication
                    (format t "~&OK")
                    (print-bindings ?variable-names ?variables))
                  ((format t "~&No answer") (cut) (false))))))
  ((:top-level-predication ?)
   (format t "~&No more answers")
   (fail)))

;;This presents only unique answers.
(define-predicate :top-level-predication
  (:options (:world :unique-answers-top-level))
  ((:top-level-predication ?predication)
   (cases ((atomic ?predication)
           (error ':bad-predication "~s must be a predication (i.e. a list)"
                  ?predication))
          ((variables ?variables ?predication)
           (variable-names ?variable-names ?predication)
           (lazy-set-of ?answers ?variables ?predication)
           (cases ((member ?answer ?answers)
                   (format t "~&OK")
                   (print-bindings ?variable-names ?answer))
                  ((format t "~&No answer") (cut) (false))))))
  ((:top-level-predication ?)
   (format t "~&No more answers")
   (fail)))

(define-predicate :ordinary-top-level (:options (:world :unique-answers-top-level))
  ((:ordinary-top-level) (remove-world :unique-answers-top-level)))

;;This one presents only unique answers and computes subsequent ones in 
;;background process.
(define-predicate :top-level-predication (:options (:world :compute-ahead-top-level))
  ((:top-level-predication ?predication)
   (cases ((atomic ?predication)
           (error ':bad-predication "~s must be a predication (i.e. a list)"
                  ?predication))
          ((variables ?variables ?predication)
           (variable-names ?variable-names ?predication)
           (eager-set-of ?answers ?variables ?predication)
           (cases ((member ?answer ?answers)
                   (format t "~&OK")
                   (print-bindings ?variable-names ?answer))
                  ((format t "~&No answer") (cut) (false))))))
  ((:top-level-predication ?)
   (format t "~&No more answers")
   (fail)))

(define-predicate :ordinary-top-level (:options (:world :compute-ahead-top-level))
  ((:ordinary-top-level) (remove-world :compute-ahead-top-level)))

;;Alan Robinson argued for this top level for Prolog...
(define-predicate :top-level-predication (:options (:world :lazy-set-top-level))
 ((:top-level-predication ?problem)
  (cases ((= ?problem (?term . (?predicator . ?arguments)))
          (lazy-set-of ?answers ?term (?predicator . ?arguments))
          (cases ((identical ?term call)
                  (cases ((= ?answers (? . ?)) (format t "~&OK"))
                         ((format t "~&No answer"))))
                 ((format t "~&(")
                  (map print-and-space ?answers)
                  (format t ")"))))
         ((format t "~&~S is not of the form (?term . ?predication)"
                  ?problem)))
  (fail) ;;to make hand-down barf
  ))

(define-predicate :ordinary-top-level (:options (:world :lazy-set-top-level))
  ((:ordinary-top-level) (remove-world :lazy-set-top-level)))

;;Parallel Prolog top-level.
(define-predicate :top-level-predication
  (:options (:world :parallel-prolog-top-level))
  ((:top-level-predication ?predication)
   (variables ?variables ?predication)
   (variable-names ?variable-names ?predication)
   (or (and (parallel-prove ?predication)
            (format t "~&OK")
            (print-bindings ?variable-names ?variables))
       (and (format t "~&No answer") (false)))))

(define-predicate :ordinary-top-level (:options (:world :parallel-prolog-top-level))
  ((:ordinary-top-level)
   ;;can't use remove-world since this may change the universe before computing it!!!
   (lisp-command (set-universe (delq ':parallel-prolog-top-level *universe*))
		 :dont-invoke)))