;;; 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)
;;; 1.0.5   07/24/06 Added hierarchical inference environments.
;;;                  (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?
  ;;  10 parent             inference-environment? or #f
  (define-values (struct:inference-environment
                  inference-environment-constructor
                  inference-environment?
                  inference-environment-field-ref
                  set-inference-environment-field!)
    (make-struct-type 'inference-environment #f 12 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))
  
  ;; parent field
  (define inference-environment-parent
    (make-struct-field-accessor
     inference-environment-field-ref 10 'parent))
  
  (define set-inference-environment-parent!
    (make-struct-field-mutator
     set-inference-environment-field! 10 'parent))
  
  ;; rules-fired field
  (define inference-environment-rules-fired
    (make-struct-field-accessor
     inference-environment-field-ref 11 'rules-fired))
  
  (define set-inference-environment-rules-fired!
    (make-struct-field-mutator
     set-inference-environment-field! 11 'rules-fired))

  ;; make-inference-environment: inference-environment? ->
  ;;   inference-environment?
  ;; make-inference-environment: -> inference-environment?
  (define make-inference-environment
    (case-lambda
      ((parent)
       (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
        parent                           ; parent
        0                                ; rules-fired
        ))
      (()
       (make-inference-environment #f))))
  
  ;; 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))))

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

  ;; current-inference-rules-fired: -> integer?
  ;; current-inference-rules-fired: integer?
  (define current-inference-rules-fired
    (case-lambda
      (()
       (inference-environment-rules-fired
        (current-inference-environment)))
      ((rules-fired)
       (set-inference-environment-rules-fired!
        (current-inference-environment) rules-fired))))
  
  ;; (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 ...))))
  
  ;; (with-new-child-inference-environment
  ;;   body ...)
  (define-syntax with-new-child-inference-environment
    (syntax-rules ()
      ((with-new-child-inference-environment
        body ...)
       (parameterize ((current-inference-environment
                       (make-inference-environment
                        (current-inference-environment))))
         body ...))))
  
  )