;;;;
;;;; FILE
;;;;	rules/linf/rretrieve.l
;;;;
;;;; DESCRIPTION
;;;;	Routines related to processing RETRIEVE queries.
;;;;
(defvar *RCS-rretrieve
  "$Header: rretrieve.l,v 1.2 89/02/21 01:24:03 hirohama Exp $")
;;;;
;;;; EXPORTS
;;;;	DoRetrieve
;;;;	calculateOneField
;;;;	runRule
;;;;	checkForNeverRules

(require "nodeDefs")

;;;
;;; DoRetrieve
;;;
(defun DoRetrieve (theTuple
		   theTargetList
		   relationDescriptor
                   relationId
		   attrDesc
		   bufferPage)
  (prog (theTupleLocks res fieldsAlreadyCalculated do-res1 do-res2)
	(setq theTupleLocks (FindTheLocksOfTheTuple theTuple
						    bufferPage
						    relationDescriptor))
	;;
	;; First check for Never retrieve rules
	;;
	(setq do-res1
	      (dolist (theField theTargetList)
		      (setq res 
			    (checkForNeverRules 'RETRIEVE
						theTuple
						theField
						theTupleLocks))
		      (if (nequal (car res) 'OK)
			  (return res))))

	(if (not (null do-res1))
	    (return do-res1))

	(setq fieldsAlreadyCalculated nil)
	(setq do-res2
	      (dolist (theField theTargetList)
		      (setq res
			    (calculateOneField theTuple
					       theField
					       theTupleLocks
					       fieldsAlreadyCalculated
					       nil
					       relationDescriptor
					       relationId
					       attrDesc
					       bufferPage))
		      (if (nequal (car res) 'OK)
			  (return res))
		      (setq fieldsAlreadyCalculated (caddr res))
		      (setq theTupleLocks (cadr res))
		      (setq theTuple (cadddr res))
		      (setq bufferPage (caddddr res))))

	(if (not (null do-res2))
	    (return do-res2))

	(setq theTuple (PutBackLocks theTuple bufferPage theTupleLocks))
	(setq bufferPage (ReturnInvalidBuffer))
	(RuleLockIntermediateFree theTupleLocks)
	(return (list 'OK theTuple bufferPage))))

;;;
;;; calculateOneField.
;;;
;;; Calculate the correct value for one given field. It returns a list with
;;; 3 (5?) elements:
;;;   1) Status (one of OK, LOOP)
;;;   2) The new locks for the tuple
;;;   3) The fields of the tuple that are calculated so far.
;;;   4) The new tuple
;;;   5) the buffer page for the new tuple
;;;
(defun calculateOneField (theTuple
			  theField
			  theTupleLocks
                          fieldsAlreadyCalculated
			  fieldsToBeCalculated
                          relDesc
			  relId
			  attrDesc
			  bufferPage)

  (prog (do-res1 result value-tuple value-attrdesc plan-no)
	;;
	;; Is this field Already calulated ?
	;;
	(if (member theField fieldsAlreadyCalculated)
	    (return (list 'OK
			  theTupleLocks
			  fieldsAlreadyCalculated
			  theTuple
			  bufferPage)))
	;;
	;; If this field is in the list of fields for which their calculation
	;; is pending, then we have entered a loop.
	;;
	(if (member theField fieldsToBeCalculated)
	    (return (list 'LOOP
			  theTupleLocks
			  (cons theField fieldsAlreadyCalculated)
			  theTuple
			  bufferPage)))
	;;
	;; OK, go  on...
	;;

	;;
	;; plan-no is the number of plans we have found so far.
	;;
	(setq plan-no 1)
	;; /*!*/
	(setq do-res1
	      (do ((planString
		    (GetPlanForField theField theTupleLocks plan-no)
		    (GetPlanForField theField theTupleLocks plan-no)))
		  ((eq 0 planString))
		  (setq result
			(runRule planString
				 theTuple
				 theField
				 theTupleLocks
				 fieldsAlreadyCalculated
				 fieldsToBeCalculated
				 relDesc
				 relId
				 attrDesc
				 bufferPage))
		  (setq plan-no (+ 1 plan-no))
		  (setq theTupleLocks (nth 1 result))
		  (setq fieldsAlreadyCalculated (nth 2 result))
		  (setq theTuple (nth 3 result))
		  (setq bufferPage (nth 4 result))
		  (setq value-tuple (prestore (nth 5 result)))
		  (setq value-attrdesc (prestore (nth 6 result)))
		  (caseq (nth 0 result)
			 ('OK
			  (if (>= DebugLevel 1)
			      (progn
				(print "Before Modify-One-Field, old tuple =")
				(terpri)
				(debugtup theTuple attrDesc)
				(terpri)
				(print "-- value-tuple")
				(terpri)))
				;;(debugtup value-tuple value-attrdesc)
;;                (setq theValue (amgetattr (cadddddr result)
;;                                          (ReturnInvalidBuffer)
;;                                          1
;;                                          (ExecGetTypeInfo relDesc)
;;                                          0))
;;		(print "Value - :") (print theValue) (terpri)
			  (setq theTuple
				(modifyOneFieldOfTheTuple theTuple
							  bufferPage
							  relDesc
							  theField
							  value-tuple
							  value-attrdesc))
;;                (setq theTuple (modify2OneFieldOfTheTuple        theTuple
;;                                                        bufferPage
;;                                                        relDesc
;;							theValue))
			  (setq bufferPage (ReturnInvalidBuffer))
			  (if (>= DebugLevel 1)
			      (progn
				(print "After Modify-One-Field, new tuple =")
				(terpri)
				(debugtup theTuple attrDesc)
				(terpri)))
			  (return (list 'OK
					theTupleLocks
					(cons theField fieldsAlreadyCalculated)
					theTuple
					bufferPage)))
			 ('LOOP
			  (return (list 'LOOP
					theTupleLocks
					(cons theField fieldsAlreadyCalculated)
					theTuple
					bufferPage)))
			 ('NOVALUEFOUND
			  ()))))
	(if (not (null do-res1))
	    (return do-res1))

	;;
	;; Use the value stored in the field.
	;;
	(return (list 'OK
		      theTupleLocks
		      (cons theField fieldsAlreadyCalculated)
		      theTuple
		      bufferPage))))

;;;
;;; runRule
;;;
;;; It returns a list of:
;;;   1) status
;;;   2) the tuple locks
;;;   3) fieldsAlreadyCalculated
;;;   4) the (new) tuple
;;;   5) the (new) buffer page
;;;   6) the value-tuple
;;;   7) the value-tupleDesc
;;;
(defun runRule (theCPlanString
		theTuple
		theField
		theTupleLocks
		fieldsAlreadyCalculated
		fieldsToBeCalculated
		relDesc
		relId
		attrDesc
		bufferPage)

  (prog (theLispPlanString
	 theOldPlanParseTree
	 theParseTree
	 theOldPlan
	 fieldsNeededInPlan
	 res
	 thePlan
	 result
	 do-res1)
	(setq theLispPlanString (string-c-to-l theCPlanString))
	(c_free theCPlanString)
	(setq theOldPlanParseTree (string-to-plan theLispPlanString))
	(setq theOldPlan (cadr theOldPlanParseTree))
	(setq theParseTree (car theOldPlanParseTree))
	;;
	;; DEBUG
	;;
	(if (>= DebugLevel 2)
	    (progn
	      (print '-------------------Plan+Parse) (terpri)
	      (print theOldPlanParseTree) (terpri)
	      (print '-------------------ORIGINAL_Plan) (terpri)
	      ;; (print theOldPlan) (terpri)
	      (print_plan theOldPlan 0)
	      (print '-------------------ParseTree) (terpri)
	      (print theParseTree) (terpri)))

	(setq fieldsNeededInPlan (find-parameters theOldPlan))
	(setq do-res1
	      (dolist (field-name fieldsNeededInPlan)
		      (setq field (get_attnum relId field-name))
		      (setq res
			    (calculateOneField theTuple
					       field
					       theTupleLocks
					       fieldsAlreadyCalculated
					       (cons theField
						     fieldsToBeCalculated)
					       relDesc
					       relId
					       attrDesc
					       bufferPage))
		      (setq theTupleLocks (cadr res))
		      (setq fieldsAlreadyCalculated (caddr res))
		      (setq theTuple (cadddr res))
		      (setq bufferPage (caddddr res))
		      (if (nequal (car res) 'OK)
			  (return (list (car res)		;status
				   theTupleLocks
				   fieldsAlreadyCalculated
				   theTuple
				   bufferPage
				   nil
				   nil)))))

	(if (not (null do-res1))
	    (return do-res1))

	(setq thePlan
	      (substituteTupleIntoPlan theOldPlan
				       theTuple
				       relDesc
				       relId
				       bufferPage))
	(if (>= DebugLevel 2)
	    (progn
	      (print '------------------Plan_AFTER_SUBST) (terpri)
	      (print_plan thePlan 0)))

	(setq result (runPlan thePlan theParseTree))
	(return (list (car result)			;status
		      theTupleLocks
		      fieldsAlreadyCalculated
		      theTuple
		      bufferPage
		      (cadr result)			;value-tuple
		      (caddr result)))))		;value-tupleDesc

;;;
;;; checkForNeverRules
;;;
(defun checkForNeverRules (neverRuleType theTuple theField theTupleLocks)
  '(OK))

;;;
;;; runPlan
;;;
;;; returns a list of
;;;   1) status
;;;   2) value-tuple
;;;   3) value tupleDesc
;;;
(defun runPlan (thePlan theParseTree)
  (prog (queryDesc state res1 res2 res3 command)
        (if (>= DebugLevel 1)
            (progn
	      (print "---entering runPlan") (terpri)))
        (if (eq (cadar theParseTree) 'replace)
	    (progn
	      (if (>= DebugLevel 1)
		  (progn
		    (print "----changing replace to retrieve") (terpri)))
	      (setq theParseTree
		    (cons (append (list (caar theParseTree) 'retrieve)
				  (cddar theParseTree))
			  (cdr theParseTree)))
	      (if (>= DebugLevel 2)
		  (progn
		    (print "-------------- NEW ParseTree") (terpri)
		    (print theParseTree) (terpri)))))
                             
	(setq state (make-exec-state))
	(if (>= DebugLevel 1)
	    (progn
	      (print "---make-exec-state made...") (terpri)))

	(setq command (cadar theParseTree))
	(if (eq command 'retone)
	    (setq command 'retrieve))
	(setq queryDesc (list command
			      theParseTree
			      thePlan
			      state
			      '(start)))
        (setq res1 (ExecMain queryDesc))
        (setq queryDesc (list command
			      theParseTree
			      thePlan
			      state
			      '(retone)))
        (setq res2 (ExecMain queryDesc))
	;;
	;; save (tuple schema-info) in LISP memory
	;;
	(if (consp res2)
	    (setq res2 (list (ppreserve (car res2))
			     (ppreserve (cadr res2)))))
	;;
        (setq queryDesc (list command
			      theParseTree
			      thePlan
			      state
			      '(end)))
        (setq res3 (ExecMain queryDesc))
	;;
	;; put (tuple schema-info) to C memory of the current context
	;;
	;;	(if (dtpr res2)
	;;	    (setq res2 (list (ppreserve-to-palloc (car res2))
	;;			     (ppreserve-to-palloc (cadr res2)))))
	;;
        (if (null res2)
	    (return (list 'NOVALUEFOUND nil nil)))
        (if (eq res2 t)
	    (return (list 'NOVALUEFOUND nil nil)))
        (return (list 'OK (car res2) (cadr res2)))))