;;; PLT Scheme Inference Collection
;;; inference.ss
;;; Copyright (c) 2006 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.
;;;
;;; Version Date     Comment
;;; 1.0.1   07/16/06 Added fields for next-assertion-id and
;;;                  assertion-index (Doug Williams)
;;; 1.0.2   07/19/06 Added trace field.  (Doug Williams)
;;; 1.0.3   07/22/06 Added agenda and rule fields.  (Doug Williams)
;;  1.0.4   07/23/06 Added strategy field.  (Doug Williams)
;;;
;;; To do:
;;; 1) Replace simple list form of agenda with a double linked form.

(module inference-environments mzscheme
  
  (provide (all-defined))
  
  ;; inverence-environment: struct
  ;;   0 data-index         hash-table?
  ;;   1 goal-index         hash-table?
  ;;   2 rule-nodes         list?
  ;;   3 exit               continuation? or #f
  ;;   4 next-assertion-id  natural-number
  ;;   5 assertion-index    hash-table?
  ;;   6 trace              boolean?
  ;;   7 agenda             list?
  ;;   8 rule               rule?
  ;;   9 strategy           symbol?
  (define-values (struct:inference-environment
                  inference-environment-constructor
                  inference-environment?
                  inference-environment-field-ref
                  set-inference-environment-field!)
    (make-struct-type 'inference-environment #f 10 0))
  
  ;; data-index field
  (define inference-environment-data-index
    (make-struct-field-accessor
     inference-environment-field-ref 0 'data-index))
  
  (define set-inference-environment-data-index!
    (make-struct-field-mutator
     set-inference-environment-field! 0 'data-index))
  
  ;; goal-index field
  (define inference-environment-goal-index
    (make-struct-field-accessor
     inference-environment-field-ref 1 'goal-index))
  
  (define set-inference-environment-goal-index!
    (make-struct-field-mutator
     set-inference-environment-field! 1 'goal-index))
  
  ;; rule-nodes field
  (define inference-environment-rule-nodes
    (make-struct-field-accessor
     inference-environment-field-ref 2 'rule-nodes))
  
  (define set-inference-environment-rule-nodes!
    (make-struct-field-mutator
     set-inference-environment-field! 2 'rule-nodes))
  
  ;; exit field
  (define inference-environment-exit
    (make-struct-field-accessor
     inference-environment-field-ref 3 'exit))
  
  (define set-inference-environment-exit!
    (make-struct-field-mutator
     set-inference-environment-field! 3 'exit))
  
  ;; next-assertion-id field
  (define inference-environment-next-assertion-id
    (make-struct-field-accessor
     inference-environment-field-ref 4 'next-assertion-id))
  
  (define set-inference-environment-next-assertion-id!
    (make-struct-field-mutator
     set-inference-environment-field! 4 'next-assertion-id))
  
  ;; assertion-index field
  (define inference-environment-assertion-index
    (make-struct-field-accessor
     inference-environment-field-ref 5 'assertion-index))
  
  (define set-inference-environment-assertion-index!
    (make-struct-field-mutator
     set-inference-environment-field! 5 'assertion-index))
  
  ;; trace field
  (define inference-environment-trace
    (make-struct-field-accessor
     inference-environment-field-ref 6 'trace))
  
  (define set-inference-environment-trace!
    (make-struct-field-mutator
     set-inference-environment-field! 6 'trace))
  
  ;; agenda field
  (define inference-environment-agenda
    (make-struct-field-accessor
     inference-environment-field-ref 7 'agenda))
  
  (define set-inference-environment-agenda!
    (make-struct-field-mutator
     set-inference-environment-field! 7 'agenda))
  
  ;; rule field
  (define inference-environment-rule
    (make-struct-field-accessor
     inference-environment-field-ref 8 'rule))
  
  (define set-inference-environment-rule!
    (make-struct-field-mutator
     set-inference-environment-field! 8 'rule))
  
  ;; strategy field
  (define inference-environment-strategy
    (make-struct-field-accessor
     inference-environment-field-ref 9 'strategy))
  
  (define set-inference-environment-strategy!
    (make-struct-field-mutator
     set-inference-environment-field! 9 'strategy))

  ;; make-inference-environment: -> inference-environment?
  (define (make-inference-environment)
    (inference-environment-constructor
     (make-hash-table)                   ; data-index
     (make-hash-table)                   ; goal-index
     '()                                 ; rule-nodes
     #f                                  ; exit
     1                                   ; next-assertion-id
     (make-hash-table)                   ; assertion-index
     #f                                  ; trace
     '()                                 ; agenda
     #f                                  ; rule
     'depth                              ; strategy
     ))
  
  ;; default-inference-environment variable
  (define default-inference-environment
    (make-inference-environment))
  
  ;; current-inference-enironment parameter
  (define current-inference-environment
    (make-parameter
     default-inference-environment
     (lambda (x)
       (when (not (inference-environment? x))
         (raise-type-error 'current-inference-environment
                           "inference-environment" x))
       x)))
  
  ;; current-inference-data-index: -> hash-table?
  ;; current-inference-data-index: hash-table?
  (define current-inference-data-index
    (case-lambda
      (()
       (inference-environment-data-index
        (current-inference-environment)))
      ((data-index)
       (set-inference-environment-data-index!
        (current-inference-environment) data-index))))
  
  ;; current-inference-goal-index: -> hash-table?
  ;; current-inference-goal-index: hash-table?
  (define current-inference-goal-index
    (case-lambda
      (()
       (inference-environment-goal-index
        (current-inference-environment)))
      ((goal-index)
       (set-inference-environment-goal-index!
        (current-inference-environment) goal-index))))
    
  ;; current-inference-rule-nodes: -> list?
  ;; current-inference-rule-nodes: list?
  (define current-inference-rule-nodes
    (case-lambda
      (()
       (inference-environment-rule-nodes
        (current-inference-environment)))
      ((rule-nodes)
       (set-inference-environment-rule-nodes!
        (current-inference-environment) rule-nodes))))
  
  ;; current-inference-exit: -> continuation? or #f
  ;; current-inference-exit: continuation? or #f
  (define current-inference-exit
    (case-lambda
      (()
       (inference-environment-exit
        (current-inference-environment)))
      ((exit)
       (set-inference-environment-exit!
        (current-inference-environment) exit))))
  
  ;; current-inference-next-assertion-id: -> natural-number
  ;; current-inference-next-assertion-id: natural-number
  (define current-inference-next-assertion-id
    (case-lambda
      (()
       (inference-environment-next-assertion-id
        (current-inference-environment)))
      ((next-assertion-id)
       (set-inference-environment-next-assertion-id!
        (current-inference-environment) next-assertion-id))))

  ;; current-inference-assertion-index: -> hash-table?
  ;; current-inference-assertion-index: hash-table?
  (define current-inference-assertion-index
    (case-lambda
      (()
       (inference-environment-assertion-index
        (current-inference-environment)))
      ((assertion-index)
       (set-inference-environment-assertion-index!
        (current-inference-environment) assertion-index))))

  ;; current-inference-trace: -> boolean?
  ;; current-inference-trace: boolean?
  (define current-inference-trace
    (case-lambda
      (()
       (inference-environment-trace
        (current-inference-environment)))
      ((trace)
       (set-inference-environment-trace!
        (current-inference-environment) trace))))

  ;; current-inference-agenda: -> list?
  ;; current-inference-agenda: list?
  (define current-inference-agenda
    (case-lambda
      (()
       (inference-environment-agenda
        (current-inference-environment)))
      ((agenda)
       (set-inference-environment-agenda!
        (current-inference-environment) agenda))))

  ;; current-inference-rule: -> rule? or #f
  ;; current-inference-rule: rule? or #f
  (define current-inference-rule
    (case-lambda
      (()
       (inference-environment-rule
        (current-inference-environment)))
      ((rule)
       (set-inference-environment-rule!
        (current-inference-environment) rule))))

  ;; current-inference-strategy: -> symbol?
  ;; current-inference-strategy: symbol?
  (define current-inference-strategy
    (case-lambda
      (()
       (inference-environment-strategy
        (current-inference-environment)))
      ((strategy)
       (set-inference-environment-strategy!
        (current-inference-environment) strategy))))
  
  ;; (with-inference-environment inference-environment
  ;;   body ..)
  (define-syntax with-inference-environment
    (syntax-rules ()
      ((with-inference-environment inference-environment
         body ...)
       (parameterize ((current-inference-environment
                       inference-environment))
         body ...))))
  
  ;; (with-new-inference-environment
  ;;   body ...)
  (define-syntax with-new-inference-environment
    (syntax-rules ()
      ((with-new-inference-environment
         body ...)
       (parameterize ((current-inference-environment
                       (make-inference-environment)))
         body ...))))
  
  )