(defpackage :fathomr
  (:export :fathom :aengel)
  (:use :common-lisp :theoretica :radiplex :db :util)
)

(in-package :fathomr)


(defclass aengel ()
  ((configuration :initform '() :accessor configuration)
   (goal :initform '() :accessor goal)
   (know :initarg :know :accessor know)
)
)



(defvar *current* '()) ; should hold root-instances

(defun wipe (setf *current* '()))


(defvar *stack* '()) ; priority stack



#|
1. a single node is as if it has a possibility of a receptor at either end, both
   for relations and for nodes at the end of relations.
2. find if there exists a connection that is possible between the nodes or either
   end of the connection and any combination of the other aengel's
   a. check within contexts (matrices?) already established for matches (cross
      match)
   b. if no context has been established, enable all possible contexts with a
      receptor at empty end
3. if a connection is possible, another aengel is formed around that connection
   (a -> b formed, receptor r: r -> a, r -> b put on stack as 2 new aengels in
   the context of the current matrix -- which now contains a -> b)
   a. find as r the constant whose aspect changes from a to b, if the relation is a
      change (an action)
   b. if found, why exactly is it then a receptor? or is this what had been a
      receptor, now bound, moving to a higher ordination?
      i. he -is-> here; he -go-> home; paradigm of change needs a previous and a
         subsequent (receptors: go is an action, so that particular matrix should be
         activated)
      ii. what exactly is cross-matching?
   c. what if a -> b is not an action, but a relation?
   d. a list of receptors available?
4. if no direct connection is possible, see if there is an intermediate node that
   can connect between them, and two other aengels are formed, with the receptor on
   the end of both; these are put back in the stack, to match again
5. if no intermediate connection is possible, create a generic dual receptor that
   connects, with one end connecting to one aengel, the other with the other aengel
   -- put this at the end of the stack (this actually makes 3 aengels, with the
   generic only added at the very end)
6. when dealing with generics (a -> g1, g1 -> g2, g2 -> b), we are trying to match
   the connection g1 -> g2 at one go (also g2 -> g1, as the link should be
   reversible... hm...)
7. if g1 -> g2 would join two matrices, see if there is a receptor r, r -> g1,
   r -> g2, where g1 element of matrix1, g2 element of matrix2; put both in stack
   a. add a context to these as "qualified" or "theoretical"
   b. if confirmed, remove such context
   c. is this cross-purpose resolution?
8. if all receptors are fulfilled within a line of context (reasoning), and we have
   one or more matrices that come as comprehension, effect is the interaction of
   comprehended matrices to time
   a. a question is interpreted into an effect, an effect is performed, a score is
      "understood"
   b. to determine what needs to be done: the constant is the object whose aspect
      changes
9. score should take all elements in the original phrase and output what these
   elements are now connected to, after effect (cross match the elements to form an
   output matrix)
   a. we could ask if an effect can be generalized
|#


;;; phrase points to a "chunked" node: (first -> (second -> (third -> etc.
;;; with null links
;;;
;;; push things onto the stack to next activate, initially if a cross match,
;;; in definitions between two words, this should top the activation... hm...
;;; is there anything else to the prioritization? what of the current state?
;;;
;;; with the spiral chunked node, wrap each node in an aengel, and set them
;;; flying (aengels knit a pattern): aengels with a non-connection node are
;;; as if they are two potential connections, with a receptor on each end in
;;; both incarnations; when a connection can be made, it becomes that type
;;; of connection, whether a specific node or receptor at the other end
;;;
;;; if it is a type of relation, then we create a connection with that in
;;; the middle and a generic receptor at the other end
;;;
;;; issues: - what are parental receptors? r -> a, r -> b, a -> b
;;;         - what does word order have to do with forming connections?
;;;           anything to do with grammar?
;;;         - where is the "feasibility check"?
(defun fathom (phrase)
  (clrhash *hash-words*)
  (let* ((original (wrapper-activate-init phrase))
         ;; at this point, we have a stack of words from beginning to end
         (init-state (reverse (fathom-init)))
)

    (if *current*
        (progn
          (setf *stack* init-state) ; reverse of the state returned
          (loop while *stack*
                do (setf *current* (fathom-parse *current*))
)
)

      (setf *current* init-state)
)

    (score original *current*)
)
)




;;; are these hierarchically descending?
;;; i.e.   (s)
;;;     (a) -> (b)
;;; (c)->(d)  (e)->(f)
;;; and does "negotiate" generate multiple possibilities, or elsewhere?
;;; what about the "third" value of a closure?


(defun fathom-init (&optional (current-state nil))
  "Initial fathoming: call the regular fathomr with just the members of the
initial phrase as populating the current state. Then return that state to be
used as the new stack (to reverse -- since we have put the first concepts at
the end, stackwise)."

  (if *stack*
      (let ((aen (pop *stack*)))
        (push aen current-state)
        (setf current-state (fathom-parse current-state))
        (fathom-init current-state)
)

    current-state
)
)



;;; the question at this point is where the third element of the closure plays
;;; a part in the "parsing" of the elements in the stack...?
(defun fathom-parse (current-state)
  "The main loop in fathoming: see upon attempting to negiotiate the top of
the stack to the elements in the current state what to add or remove from
the current state, then recurse upon that new state if there is any left in
the stack, else return what is in the current state."

  (if *stack*
      (let ((aen (pop *stack*))
            (new-state '())
)

        (multiple-value-bind (to-add to-remove) 
            (negotiate-all current-state aen)
          ;; it is assumed that negotiate will add to the stack if needed;
          ;; it should also be able to remove from the stack
          (setf new-state (set-difference current-state to-remove))
          (nconc new-state to-add)
          ;; we have a valid line, then continue: use the state to recurse
          ;; if the line is not valid, return -- throw away the state
          ;; what is valid? to-add is not null
          (if to-add
              (fathom-parse new-state)
            current-state
)
)
)

    current-state
)
)


(defun negotiate-all (current-state aen)
  "Attempt to negotiate the aengel passed in with all elements of the current
state passed in, collect all to add and to remove from that state."

  (let ((to-add-all '())
        (to-remove-all '())
)

    (loop for aen-worker in current-state
          do (multiple-value-bind (to-remove to-add) 
                 (negotiate aen-worker aen) ; do we pass in current state?
               (nconc to-remove-all to-remove)
               (nconc to-add-all to-add)
)
)

    (values to-add-all to-remove-all)
)
)

      

(defvar *hash-words* (make-hash-table :test 'equal))

(defun wrapper-activate-init (phrase)
  "Activate words in the phrase by wrapping them in aengels and by putting
them in the stack in the order they came in the sentence, updating a hash
table with the frequency of each word."

  (when phrase
    (let* ((word (prev phrase))
           (count (gethash word *hash-words*))
)

      (unless count
        (setf count 0)
)

      (setf (gethash word *hash-words*) (1+ count))
      ;; or is it the same aengel if count > 0? or the same node?
      ;; do we "abstract" here?
      ;; at first, we have words & possible parts of speech -- which then
      ;;   lead to definitions
      (let ((ae (make-instance 'aengel :know (lookup word))))
        (wrapper-activate-init (subs phrase))
        (push ae *stack*)
)
)
)
)
 ; push in reverse order so first in phrase
                              ; is first to be popped

;;; negotiation is the nitty gritty of the interaction of aengels, and the
;;; "rules" for it go into how they can organize things, themselves - meta?
;;; returns (lists of) what to remove and what to add (multiple values)
(defun negotiate (aengel1 aengel2)
  T
)



;;; if not found, then look up using socket server
(defun lookup (word)
  (load-one-word word)
)



(defun chunk (phrase)
  (let ((split-phrase (split phrase)))
    (chunk-list split-phrase)
)
)


(defun chunk-list (phrase-list)
  (when phrase-list
    (let ((one (make-instance 'node :data (car phrase-list)))
          (other (cdr phrase-list))
)

      (if other
          (let ((encompassing (make-instance 'node :prev one)))
            (setf (subs encompassing) (chunk-list other))
            encompassing
)

        one
)
)
)
)