;; BAGGER
;; Derived from the example on pages 132ff of the textbook.

;; Assertions in this Bagger system are of one of the following
;; disjoint formats:
;; (STEP IS <name-of-step>)
;;    Holds the name of the current step, one of
;;      check-order, bag-large-items, bag-medium-items, bag-small-items, done
;; (<bag#> IS <available-or-current-bag>)
;;    Status of each bag,
;;      available-bag, current-bag, or none (filled)
;; (<item#> <kind> <container> <size> <frozen?>) 
;;    Items to be bagged, as in table on pg 132 of textbook.
;; (<bag#> CONTAINS <item#> <size>)
;;    Contents of each bag, one assertion for each item.
;; (<item#> IN FREEZER-BAG)
;;    Item needs special packing in freezer bag.

;;;; BAGGER TEST DATA

(define (make-groceries)
  (clear-assertions)
  (remember-assertions

   '(step is check-order)

   '(bag1 is current-bag)
   '(bag2 is available-bag)
   '(bag3 is available-bag)
   '(bag4 is available-bag)

   ;; Similar to table on page 132 of text:
   ;;ITEM# KIND         CONTAINER-TYPE   SIZE   FROZEN?
   '(item1 Bread        Plastic-bag      Medium No)
   '(item2 Glop         Jar              Small  No)
   '(item3 Granola      Cardboard-box    Large  No)
   '(item4 Ice-cream    Cardboard-carton Medium Yes)
   '(item5 Potato-chips Plastic-bag      Medium No)
   '(item6 Crackers     Cardboard-box    Large  No)
   '(item7 Juice        Bottle           Large  No)
   '(item8 Peaches      Can              Large  No))

  (format #t "~%Bagger grocery list recorded:")
  (display-assertions *assertions*))

;;;; BAGGER RULES

(define (make-bagger-rules)
  (clear-rules)
  (remember-rules
   ;; How about a Pepsi with those potato chips?
   '(B1 IF
	(step is check-order)
	((? _) potato-chips (? _) (? _) (? _))
	AND-IF
	(= 0 (count-assertions '((? _) pepsi (? _) (? _) (? _))))
	ADD (item0 Pepsi Bottle Large No)
	SAYING ("Add a bottle of Pepsi to the order."))
   ;; Start bagging large items.
   '(B2 IF
	(step is check-order)
	((? bag) is current-bag)
	DELETE (step is check-order) 
	ADD (step is bag-large-items)
	SAYING ("Bagging large items."))
   ;; Bag a large bottle if there are fewer than 3 large items in bag.
   '(B3 IF
	(step is bag-large-items)
	((? bag) is current-bag)
	((? item) (? class) bottle large (? f))
	AND-IF
	(< (count-assertions '((? bag) contains (? _) large)) 3)
	DELETE ((? item) (? class) bottle large (? f)) 
	ADD ((? bag) contains (? item) large)
	SAYING ("Put ~a, ~a, in ~a." (? item) (? class) (? bag)))
   ;; Bag a large item if there are fewer than 4 large items in bag.
  '(B4 IF
       (step is bag-large-items)
       ((? bag) is current-bag)
       ((? item) (? class) (? c) large (? f))
       AND-IF
       (< (count-assertions '((? bag) contains (? _) large)) 4)
       DELETE ((? item) (? class) (? c) large (? f)) 
       ADD ((? bag) contains (? item) large)
       SAYING ("Put ~a, ~a, in ~a." (? item) (? class) (? bag)))
  ;; Start a new bag, if large items are left unbagged.
  '(B5 IF
       (step is bag-large-items)
       ((? bag) is current-bag)
       ((? item) (? _) (? _) large (? _))
       ((? new-bag) is available-bag)
       DELETE
       ((? bag) is current-bag)
       ((? new-bag) is available-bag)
       ADD ((? new-bag) is current-bag)
       SAYING ("Start a fresh bag."))
  ;; Switch to bagging medium items.
  '(B6 IF
       (step is bag-large-items)
       ((? bag) is current-bag)
       DELETE (step is bag-large-items) 
       ADD (step is bag-medium-items)
       SAYING ("Bagging medium items."))
  ;; Place ice-cream in a freezer bag.
  '(B7 IF
       (step is bag-medium-items)
       ((? bag) is current-bag)
       ((? item) ice-cream (? _) (? _) yes)
       ADD ((? item) in freezer-bag)
       SAYING ("Put ~a, ~a, in a freezer bag." (? item) 'ice-cream))
  ;; Bag medium item if no large items and fewer than 6 medium items
  ;; in current bag.
  '(B8 IF
       (step is bag-medium-items)
       ((? bag) is current-bag)
       ((? item) (? class) (? c) medium (? f))
       AND-IF
       (= (count-assertions '((? bag) contains (? _) large)) 0)
       (< (count-assertions '((? bag) contains (? _) medium)) 6)
       DELETE ((? item) (? class) (? c) medium (? f)) 
       ADD ((? bag) contains (? item) medium)
       SAYING ("Put ~a, ~a, in ~a." (? item) (? class) (? bag)))
  ;; Start a new bag, if medium items are left unbagged.
  '(B9 IF
       (step is bag-medium-items)
       ((? bag) is current-bag)
       ((? item) (? _) (? _) medium (? _))
       ((? new-bag) is available-bag)
       DELETE
       ((? bag) is current-bag)
       ((? new-bag) is available-bag)
       ADD ((? new-bag) is current-bag)
       SAYING ("Start a fresh bag."))
  ;; Switch to bagging small items.
  '(B10 IF
	(step is bag-medium-items)
	((? bag) is current-bag)
	DELETE (step is bag-medium-items) 
	ADD (step is bag-small-items)
	SAYING ("Bagging small items."))
  ;; Bag small item if no large items and fewer than 10 small items
  ;; in current bag.
  '(B11 IF
	(step is bag-small-items)
	((? bag) is current-bag)
	((? item) (? class) (? c) small (? f))
	AND-IF
	(= (count-assertions '((? bag) contains (? _) large)) 0)
	(< (count-assertions '((? bag) contains (? _) small)) 10)
	DELETE ((? item) (? class) (? c) small (? f)) 
	ADD ((? bag) contains (? item) small)
	SAYING ("Put ~a, ~a, in ~a." (? item) (? class) (? bag)))
  ;; Start a new bag, if small items are left unbagged.
  '(B12 IF
	(step is bag-small-items)
	((? bag) is current-bag)
	((? item) (? _) (? _) small (? _))
	((? new-bag) is available-bag)
	DELETE
	((? bag) is current-bag)
	((? new-bag) is available-bag)
	ADD ((? new-bag) is current-bag)
	SAYING ("Start a fresh bag."))
  ;; We're done.
  '(B13 IF
	(step is bag-small-items)
	((? bag) is current-bag)
	DELETE
	((? bag) is current-bag)
	(step is bag-small-items)
	ADD (step is done)
	SAYING ("Bagging done.")))
  (format #t "~%Bagger rules recorded."))

(define (bagger-run)
 (make-bagger-rules)
 (make-groceries)
 (chain)
 (display-assertions *assertions*))