SICP/ex-4_70-79.scm

(load "util.scm")
(load "misc/sicp-query.scm")

(initialize-data-base microshaft-data-base)

(display "\nex-4.70 let-in-add-assertion\n")

; If we assigned to THE-ASSERTIONS directly then the new stream would reference
; itself and we would get an endless stream of the current assertion.
(display "[answered]\n")

(display "\nex-4.71 - simpler-simple-query\n")

; Using delay for the rule part can help to print at least some results before
; a potential endless loop.

; (eval-query '(rule (married ?x ?y)
;                    (married ?y ?x)))

; (eval-query '(married Minnie ?x))

(display "[answered]\n")

; I got this solution from SICP solutions because I could not think of a good
; example. It would be better to implement the loop-avoidance algorithm than
; relying on delayed evaluation to get some results, in my opinion.

(display "\nex-4.72 - stream-interleave\n")

; If only one of the disjuncts produces a result and the others create an
; endless-loop, interleaving guarantess that we get some results for the valid
; disjuncts.

(display "[answered]\n")


(display "\nex-4.73 - explicit-delay\n")

; The second argument to interleave must be delayed explicitly because
; MIT-Scheme's applicative-order-evaluation would evaluate the complete stream,
; otherwise. That would make the use of streams pointless.

(display "[answered]\n")

(display "\nex-4.74 - simple-stream-flatmap\n")

(define (simple-stream-flatmap proc s)
  (simple-flatten (stream-map proc s)))

(define (stream-not-null? x)
  (not (stream-null? x)))

(define (simple-flatten stream)
  (stream-map stream-car
              (stream-filter stream-not-null? stream)))

(eval-query
  '(and (salary (Bitdiddle Ben) ?ben-amount)
        (salary ?person ?amount)
        (lisp-value > ?amount ?ben-amount)))
(newline)

; The query system's behavior does not change because interleaving does not
; have an effect for empty and singleton streams.

(display "\nex-4.75 - unique\n")

(eval-query
  '(unique (job ?x (computer wizard))))
(newline)

(eval-query
  '(unique (job ?x (computer programmer))))
(newline)

(eval-query
  '(and (job ?x ?j) (unique (job ?anyone ?j))))
(newline)

(eval-query
  '(and (job ?p ?j) (unique (supervisor ?s ?p))))
(newline)

(display "\nex-4.76\n")

(display "\nex-4.77\n")

;(display "\nex-4.78\n")
;(display "\nex-4.79\n")