(module assertions mzscheme
(provide (all-defined))
(require "inference-environments.ss")
(define (assertion-print assertion port write?)
(when write? (write-string "<" port))
(if write?
(fprintf port "assertion-~a: ~s"
(assertion-id assertion)
(assertion-fact assertion))
(fprintf port "assertion-~a: ~a"
(assertion-id assertion)
(assertion-fact assertion)))
(when (assertion-reason assertion)
(fprintf port "; ~a"
(assertion-reason assertion)))
(when write? (write-string ">" port)))
(define-values (struct:assertion
assertion-constructor
assertion?
assertion-field-ref
set-assertion-field!)
(make-struct-type 'assertion #f 3 0 #f
(list (cons prop:custom-write assertion-print))
(make-inspector)))
(define assertion-id
(make-struct-field-accessor
assertion-field-ref 0 'id))
(define set-assertion-id!
(make-struct-field-mutator
set-assertion-field! 0 'id))
(define assertion-fact
(make-struct-field-accessor
assertion-field-ref 1 'fact))
(define set-assertion-fact!
(make-struct-field-mutator
set-assertion-field! 1 'fact))
(define assertion-reason
(make-struct-field-accessor
assertion-field-ref 2 'reason))
(define set-assertion-reason!
(make-struct-field-mutator
set-assertion-field! 2 'reason))
(define (make-assertion fact reason)
(let ((assertion (assertion-constructor
(current-inference-next-assertion-id)
fact reason)))
(current-inference-next-assertion-id
(+ (current-inference-next-assertion-id) 1))
assertion))
(define (assertions-subset? assertions-1 assertions-2)
(cond ((null? assertions-1) #t)
((null? assertions-2) #f)
((not (eq? (car assertions-1) (car assertions-2))) #f)
(else
(assertions-subset? (cdr assertions-1) (cdr assertions-2)))))
)