; Risoluzione di Problemi nel mondo dei Blocchi (versione per JESS)
; Utilizza strategia iterative deepening


;(defmodule MAIN (export ?ALL))

(deftemplate MAIN::solution (slot value (default no))) 
(deffacts MAIN::param
       (solution (value no)) (maxdepth 0))

(deffacts MAIN::S0
      (status 0 clear a NA) (status 0 on a b ) (status 0 on b c ) (status 0 ontable c NA) 
      (status 0 ontable d NA) (status 0 clear d NA)
      (status 0 handempty NA NA))

(deffacts MAIN::final
      (goal on  a b) (goal on c d) (goal ontable d NA) (goal on b c))

(defrule MAIN::trovato
(declare (salience 100))
	(risolto)=>
	(printout t crlf "risolto" crlf)(halt)
)

(defrule MAIN::pulisci
	(declare (salience 75))
	?f <- (status ?x&~0 ? ? ?) => (retract ?f))

(defrule MAIN::pulisci2
	(declare (salience 75))
	?f <- (exec $?) => (retract ?f))

(defrule MAIN::pulisci3
	(declare (salience 75))
	?f <- (ancestor $?) => (retract ?f))

(defrule MAIN::risolvi
(declare (salience 50))
    ?f1<-(maxdepth ?x)=>
	(retract ?f1)
	(assert (maxdepth (+ ?x 1)))
	(printout t crlf "maxdepth " (+ ?x 1) crlf)
	(focus MAIN2)
)
	


(defmodule MAIN2 );(import MAIN ?ALL)(export ?ALL))
(defrule got-solution
(declare (salience 100))
(solution (value yes)) => 
	(assert (risolto))
	(pop-focus)
)

(defrule pick
   (status ?s on ?x ?y)
   (status ?s clear ?x ?)
   (status ?s handempty ? ?)
   (maxdepth ?d)
    (test (< ?s ?d))
      (not (exec ?s pick ?x ?y)) 
   => (assert (apply ?s pick ?x ?y)))

(defrule apply-pick2
		(declare (salience 1))
       (apply ?s pick ?x ?y)
?f <-  (exec ?t ? ? ?)
       (test (> ?t ?s))
 =>    (retract ?f))

(defrule apply-pick1
		(declare (salience 2))
        (apply ?s pick ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))


(defrule apply-pick3
?f <- (apply ?s pick ?x ?y)
 =>    (retract ?f)
      (assert (delete ?s on ?x ?y))
      (assert (delete ?s clear ?x NA))
      (assert (delete ?s handempty NA NA))
      (assert (status (+ ?s 1) clear ?y NA))
      (assert (status (+ ?s 1) holding ?x NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s pick ?x ?y )))

(defrule picktable
   (status ?s ontable ?x ?)
   (status ?s clear ?x ?)
   (status ?s handempty ? ?)
   (maxdepth ?d)
   (test (< ?s ?d))
   (not (exec ?s picktable ?x NA)) 
   => (assert (apply ?s picktable ?x NA)))

(defrule apply-picktable2
		(declare (salience 1))
        (apply ?s picktable ?x ?y)
?f <-  (exec ?t ? ? ?)
       (test (> ?t ?s))
 =>    (retract ?f))

(defrule apply-picktable1
		(declare (salience 2))
        (apply ?s picktable ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))


(defrule apply-picktable3
?f <- (apply ?s picktable ?x ?y)
 =>   (retract ?f)
      (assert (delete ?s ontable ?x NA))
      (assert (delete ?s clear ?x NA))
      (assert (delete ?s handempty NA NA))
      (assert (status (+ ?s 1) holding ?x NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s picktable ?x NA)))

(defrule put
   (status ?s holding ?x ?)
   (status ?s clear ?y ?)
   (maxdepth ?d)
   (test (< ?s ?d)) 
   (not (exec ?s put ?x ?y)) 
   => (assert (apply ?s put ?x ?y)))

(defrule apply-put2
		(declare (salience 1))
        (apply ?s put ?x ?y)
 ?f <-  (exec ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))
 
(defrule apply-put1
 		(declare (salience 2))
 		(apply ?s put ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))


(defrule apply-put3
?f <- (apply ?s put ?x ?y)
 =>   (retract ?f)
      (assert (delete  ?s holding ?x NA))
      (assert (delete  ?s clear ?y NA))
      (assert (status (+ ?s 1) on ?x ?y))
      (assert (status (+ ?s 1) clear ?x NA))
      (assert (status (+ ?s 1) handempty NA NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s put ?x ?y)))

(defrule puttable
   (status ?s holding ?x ?)
   (maxdepth ?d)
   (test (<  ?s  ?d))
   (not (exec ?s puttable ?x NA)) 
   => (assert (apply ?s puttable ?x NA)))

(defrule apply-puttable2
		(declare (salience 1))
        (apply ?s puttable ?x ?y)
 ?f <-  (exec ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))

(defrule apply-puttable1
		(declare (salience 2))
        (apply ?s puttable ?x ?y)
 ?f <-  (status ?t ? ? ?)
        (test (> ?t ?s))
 =>     (retract ?f))


(defrule apply-puttable3
?f <- (apply ?s puttable ?x ?y)
 =>    (retract ?f)(assert (delete ?s holding ?x NA))
      (assert (status (+ ?s 1) ontable ?x NA))
      (assert (status (+ ?s 1) clear ?x NA))
      (assert (status (+ ?s 1)handempty NA NA))
      (assert (current ?s))
      (assert (news (+ ?s 1)))
      (focus CHECK)
      (assert (exec ?s puttable ?x NA)))

(defmodule CHECK );(import MAIN2 ?ALL) (export ?ALL))

(defrule comp
    (declare (salience 100))
    (MAIN2::current ?s)
    (status ?s ?op ?x ?y)
    (not (MAIN2::delete ?s ?op ?x ?y))
 => (assert (status (+ ?s 1) ?op ?x ?y)))

(defrule goal-not-yet
      (declare (salience 50))
      (MAIN2::news ?s)
      (goal ?op ?x ?y)
      (not (status ?s ?op ?x ?y))
      => (assert (task go-on)) 
         (assert (MAIN2::ancestor (- ?s 1)))
         (focus NEW))

(defrule solution-exist
 ?f <-  (solution (value no))
         => 
        (modify ?f (value yes))
        (pop-focus))

(defmodule NEW );(import CHECK ?ALL) (export ?ALL))

(defrule check-ancestor
    (declare (salience 50))
?f1 <- (MAIN2::ancestor ?a) 
    (or (test (> ?a 0)) (test (= ?a 0)))
    (MAIN2::news ?s)
    (status ?s ?op ?x ?y)
    (not (status ?a ?op ?x ?y)) 
    =>
    (assert (MAIN2::ancestor (- ?a 1)))
    (retract ?f1)
    (assert (diff ?a)))

(defrule all-checked
       (declare (salience 25))
       (diff 0) 
?f2 <- (MAIN2::news ?n)
?f3 <- (CHECK::task go-on) =>
       (retract ?f2)
       (retract ?f3)
       (focus DEL))

(defrule already-exist
?f <- (CHECK::task go-on)
      => (retract ?f)
         (assert (remove newstate))
         (focus DEL))

(defmodule DEL );(import NEW ?ALL))          
       
(defrule del1
(declare (salience 50))
?f <- (MAIN2::delete $?)
=> (retract ?f))

(defrule del2
(declare (salience 100))
?f <- (NEW::diff ?)
=> (retract ?f))

(defrule del3
(declare (salience 25))
       (NEW::remove newstate)
       (MAIN2::news ?n)
 ?f <- (status ?n ?  ? ?)
=> (retract ?f))

(defrule del4
(declare (salience 10))
?f1 <- (NEW::remove newstate)
?f2 <- (MAIN2::news ?n)
=> (retract ?f1)
   (retract ?f2))

(defrule done
 ?f <- (MAIN2::current ?x) => 
(retract ?f)
(pop-focus)
(pop-focus)
(pop-focus))