Ya pregunta al usuario si le fue bien o mal con su campeon

(deftemplate campeon
	(slot nombre (type STRING))
  (multislot tiene-rols)
	(slot salud (type INTEGER))
	(slot ataque (type INTEGER))
	(slot hechizo (type INTEGER))
	(slot dificultad (type INTEGER))
	(slot fecha (type STRING))
	(slot puntosip (type INTEGER))
	(slot puntosrp (type INTEGER))
	(slot prioridad (type INTEGER))
  (multislot ga)
  (multislot ba)
  (multislot gw)
  (slot ban (type INTEGER))
)
(deftemplate prioridad
  (slot tipo (type STRING))
  (slot champ1 (type STRING))
  (slot champ2 (type STRING))
  (slot flag (type INTEGER))
)
; Aatrox
(defglobal ?*equipo* = 0) ; equipo que pertenece el jugador de abajo que representa al usuario
(defglobal ?*player* = 0) ; eleccion de # jugador que representa al usuario
(defglobal ?*candidatos* = 0) ; lista de candidatos ordenado segun prioridad de la lista de abajo
(defglobal ?*prioridades* = 0) ; lista de prioridades de campeones de arriba en orden descendente

(defglobal ?*campeones* = 0) ; lista de jugadores elegidos ordenado segun reglas de elección de campeon
(defglobal ?*equipos* = 0) ; equipo que pertenece el jugador que elegio el campeon en la lista de arriba

;(defrule le-fue-bien
;	(salience 187)
;	(comolefue 1)
;	?p <- (campeon (nombre ?**))
;=>
;	(modify ?p (+ prioridad 1))
;)
;(defrule le-fue-mal
;	(salience 187)
;	(comolefue 0)
;	?p <- (campeon (nombre ?**))
;=>
;	(modify ?p (- prioridad 1))
;)
(defrule como-le-fue
(declare (salience 186))
  (juega-con ?player ?equipo ?campeon)
  (test (and (eq ?player ?*player*) (eq ?equipo ?*equipo*)))
  ?p <- (campeon (nombre ?campeon) (prioridad ?prioridad) (ban 1))
=>
	(printout t "Ud. es el jugador #" ?*player* " del equipo " ?*equipo* ". " crlf "Con prioridad igual a " ?prioridad ", le fue bien a tu campeon \"" ?campeon "\" ? si o no: ")
	(bind ?comolefue (readline))
  (if (eq ?comolefue "si")
    then (modify ?p (prioridad (+ ?prioridad 1))(ban 2)) (printout t "nueva prioridad + " (+ ?prioridad 1) crlf)
    else (modify ?p (prioridad (- ?prioridad 1))(ban 2)) (printout t "nueva prioridad - " (- ?prioridad 1) crlf)
  )
)
; ORDEN DE ELECCION
; 1a
; 1m
; 2m
; 2a
; 3a
; 3m
; 4m
; 4a
; 5a
; 5m
(defrule prioridad-gw
  (declare (salience 198)); mas alto que los ingreso-#equipo
  (juega-con ?jugador ?equipo ?campeon)
  ?f0 <- (prioridad (tipo "gw") (champ1 ?campeon) (champ2 ?gw) (flag 0))
  (juega-con ?jug&~?jugador ?equipo ?gw) ; existe el gw en su equipo
  ?f1 <- (campeon (nombre ?campeon) (prioridad ?prioridad))
=>
  (modify ?f0 (flag 1))
  (modify ?f1 (prioridad (+ ?prioridad 1)))
  (printout t "Subiendo prioridad a " ?campeon " de jugador " ?jugador " y equipo " ?equipo " porque es gw con " ?gw crlf)
)
(defrule prioridad-ga
  (declare (salience 198)); mas alto que los ingreso-#equipo
  (juega-con ?jugador ?equipo ?campeon)
  ?f0 <- (prioridad (tipo "ga") (champ1 ?campeon) (champ2 ?ga) (flag 0))
  (juega-con ?jug ?equi&~?equipo ?ga) ; no existe el ga en su equipo
  ?f1 <- (campeon (nombre ?campeon) (prioridad ?prioridad))
=>
  (modify ?f0 (flag 1))
  (modify ?f1 (prioridad (+ ?prioridad 1)))
  (printout t "Subiendo prioridad a " ?campeon " de jugador " ?jugador " y equipo " ?equipo " porque es ga con " ?ga crlf)
)
(defrule prioridad-ba
  (declare (salience 198)); mas alto que los ingreso-#equipo
  (juega-con ?jugador ?equipo ?campeon)
  ?f0 <- (prioridad (tipo "ba") (champ1 ?campeon) (champ2 ?ba) (flag 0))
  (juega-con ?jug ?equi&~?equipo ?ba) ; no existe el ba en su equipo
  ?f1 <- (campeon (nombre ?campeon) (prioridad ?prioridad))
=>
  (modify ?f0 (flag 1))
  (modify ?f1 (prioridad (+ ?prioridad 1)))
  (printout t "Restando prioridad a " ?campeon " de jugador " ?jugador " y equipo " ?equipo " porque es ba con " ?ba crlf)
)
(defrule ingreso-campeon-fase2
  (declare (salience 199)); mas alto que los ingreso-#equipo
  (con-posicion ?jugador ?equipo ?pos)
=>
  (printout t crlf "Top 3 Campeones Recomendados:" crlf)
  (printout t (implode$ (subseq$ ?*candidatos* 1 3)) crlf)
  (bind ?*candidatos* 0) ; limpiar la lista
  (bind ?*prioridades* 0) ; limpiar la lista
  (printout t "Ingrese nombre del campeon: ")
  (bind ?campeon (readline))
  (assert (juega-con ?jugador ?equipo ?campeon))
  (if (integerp ?*campeones*)
    then ; eliminar el campo 0
      (bind ?*campeones* ?*campeones* ?campeon)
      (bind ?*equipos* ?*equipos* ?equipo)
      (bind ?*campeones*   (delete$ ?*campeones*  1 1))
      (bind ?*equipos*  (delete$ ?*equipos* 1 1))
    else ; ingreso normal
      (bind ?*campeones* ?*campeones* ?campeon)
      (bind ?*equipos* ?*equipos* ?equipo)
  )
  (assert (ban ?campeon)) ; ya no se podra elegir
  (printout t crlf)
)
(defrule ingreso-campeon
  (declare (salience 200)); mas alto que los ingreso-#equipo
  (con-posicion ?jugador ?equipo ?pos)(tiene-codigo ?posicion ?pos)
  (puede-con ?pos $?rols)

  (campeon
    (nombre ?campeon)
    (tiene-rols ?r1 ?r2
      &:(or (member ?r1 $?rols)(member ?r2 $?rols))
    )
    (prioridad ?prioridad)
    (gw $?allgw)
    (ga $?allga)
    (ba $?allba)
    (ban 0)
  )
=>
  (if (integerp ?*candidatos*)
    then
      (bind ?*candidatos* ?*candidatos* ?campeon)
      (bind ?*prioridades* ?*prioridades* ?prioridad)
      (bind ?*candidatos*   (delete$ ?*candidatos*  1 1))
      (bind ?*prioridades*  (delete$ ?*prioridades* 1 1))
      ;(printout t "ELIMINANDO" crlf)
    else ; ingrese ordenado segun prioridad
      ; antes, modificar prioridad a causa de campeones elegidos anteriormente
      (bind ?pri ?prioridad); la prioridad a modificar del candidato
      (if (not (integerp ?*campeones*)) ; por lo menos ya se ha elegido el primer campeon
        then
          (bind ?len (length$ ?*campeones*))
          (loop-for-count (?a 1 ?len); iterar los campeones ya elegidos (maximo 9)
            (bind ?chosenChamp (nth$ ?a ?*campeones*)) ; nombre de campeon elegido
            (bind ?chosenTeam (nth$ ?a ?*equipos*)) ; equipo que elegio el campeon
            (loop-for-count (?i 1 10); iterar por gw ga ba del campeon candidato
              (bind ?igw (nth$ ?i $?allgw))
              (bind ?iga (nth$ ?i $?allga))
              (bind ?iba (nth$ ?i $?allba))

              (if (and (eq ?igw ?chosenChamp)(eq ?chosenTeam ?equipo))
                then (bind ?pri (+ ?pri 1)); sumar prioridad
                ;(printout t "sumando gw" crlf)
                else
                  (if (and (eq ?iga ?chosenChamp)(neq ?chosenTeam ?equipo))
                    then (bind ?pri (+ ?pri 1)); sumar prioridad
                      ;(printout t "sumando ga" crlf)
                    else
                      (if (and (eq ?iba ?chosenChamp)(neq ?chosenTeam ?equipo))
                        then (bind ?pri (- ?pri 1)); restar prioridad
                        ;(printout t "sumando ba" crlf)
                      )
                  )
              )
            )
          )
      )
      ; ahora si, el ingreso ordenado
      (bind ?length (length$ ?*candidatos*))
      (bind ?nswapped True)
      (loop-for-count (?x 1 ?length)
          (bind ?prioridadLista (nth$ ?x ?*prioridades*))
          (if (>= ?pri ?prioridadLista)
            then
              ; make the swap happen :)
              (bind ?*candidatos* (insert$ ?*candidatos* ?x ?campeon))
              (bind ?*prioridades* (insert$ ?*prioridades* ?x ?pri))
              (bind ?nswapped False)
              ;(printout t "ROMPIENDO" crlf)
              (break)
          )
      )
      (if (eq ?nswapped True)
        then ; anadir al final de la lista
          (bind ?*candidatos* ?*candidatos* ?campeon)
          (bind ?*prioridades* ?*prioridades* ?pri)
      )
  )
  ;(printout t crlf "== " ?jugador " == " ?posicion " == " $?rols " == " ?r1 " == " ?r2 " == " ?campeon " == prioridad " ?prioridad  crlf crlf)
)
(defrule ingreso-5m
  (declare (salience 190))
  (jugador 5 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 5 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 5 "m" ?pos))
)
(defrule ingreso-5a
  (declare (salience 190))
  (jugador 5 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 5 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 5 "a" ?pos))
  (assert (jugador 5 "m")) ; proximo jugador que elije
)
(defrule ingreso-4a
  (declare (salience 190))
  (jugador 4 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 4 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 4 "a" ?pos))
  (assert (jugador 5 "a")) ; proximo jugador que elije
)
(defrule ingreso-4m
  (declare (salience 190))
  (jugador 4 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 4 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 4 "m" ?pos))
  (assert (jugador 4 "a")) ; proximo jugador que elije
)
(defrule ingreso-3m
  (declare (salience 190))
  (jugador 3 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 3 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 3 "m" ?pos))
  (assert (jugador 4 "m")) ; proximo jugador que elije
)
(defrule ingreso-3a
  (declare (salience 190))
  (jugador 3 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 3 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 3 "a" ?pos))
  (assert (jugador 3 "m")) ; proximo jugador que elije
)
(defrule ingreso-2a
  (declare (salience 190))
  (jugador 2 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 2 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 2 "a" ?pos))
  (assert (jugador 3 "a")) ; proximo jugador que elije
)
(defrule ingreso-2m
  (declare (salience 190))
  (jugador 2 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 2 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 2 "m" ?pos))
  (assert (jugador 2 "a")) ; proximo jugador que elije
)
(defrule ingreso-1m
  (declare (salience 190))
  (jugador 1 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 1 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 1 "m" ?pos))
  (assert (jugador 2 "m")) ; proximo jugador que elije
)
(defrule ingreso-1a
  (declare (salience 190))
  (jugador 1 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 1 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert (jugador 1 "m")) ; proximo jugador que elije
  (assert(con-posicion 1 "a" ?pos))
)
(defrule trato-ban
(declare (salience 201))
  ?b <- (ban ?campeon)
  ?p <- (campeon (nombre ?campeon) (ban 0))
=>
  (modify ?p (ban 1))
  (retract ?b)
)
(defrule ingreso-informacion1
(declare (salience 201))
   (initial-fact)
=>
	(printout t "Modo Blind-Pick" crlf)

	;(assert (flag201 1))
  (assert (ban "Irelia"))
  (assert (ban "Janna"))
  (assert (ban "Jarvan IV"))
  (assert (ban "Jax"))
  (assert (ban "Jayce"))
  (assert (ban "Jinx"))

	(printout t crlf "Ingrese equipo a pertener, Azul o Morado: ")
	(bind ?*equipo* "a")

	(printout t crlf "Ingrese el # de jugador (1 - 6) del equipo " ?*equipo* ": ")
	(bind ?*player* 1)
	(printout t crlf)
  (assert (jugador 1 "a")) ; proximo jugador que elije
)
(defrule inicio
(declare (salience 202))
  (initial-fact)
=>
  (load-facts limited_facts.clp)
	;(printout t " Exito!!, Se cargaron los datos correctamente" crlf crlf )
)

(deftemplate campeon
	(slot nombre (type STRING))
  (multislot tiene-rols)
	(slot salud (type INTEGER))
	(slot ataque (type INTEGER))
	(slot hechizo (type INTEGER))
	(slot dificultad (type INTEGER))
	(slot fecha (type STRING))
	(slot puntosip (type INTEGER))
	(slot puntosrp (type INTEGER))
	(slot prioridad (type INTEGER))
  (multislot ga)
  (multislot ba)
  (multislot gw)
  (slot ban (type INTEGER))
)
(deftemplate prioridad
  (slot tipo (type STRING))
  (slot champ1 (type STRING))
  (slot champ2 (type STRING))
  (slot flag (type INTEGER))
)
; Aatrox
(defglobal ?*equipo* = 0) ; equipo que pertenece el jugador de abajo que representa al usuario
(defglobal ?*player* = 0) ; eleccion de # jugador que representa al usuario
(defglobal ?*candidatos* = 0) ; lista de candidatos ordenado segun prioridad de la lista de abajo
(defglobal ?*prioridades* = 0) ; lista de prioridades de campeones de arriba en orden descendente

(defglobal ?*campeones* = 0) ; lista de jugadores elegidos ordenado segun reglas de elección de campeon
(defglobal ?*equipos* = 0) ; equipo que pertenece el jugador que elegio el campeon en la lista de arriba

;(defrule le-fue-bien
;	(salience 187)
;	(comolefue 1)
;	?p <- (campeon (nombre ?**))
;=>
;	(modify ?p (+ prioridad 1))
;)
;(defrule le-fue-mal
;	(salience 187)
;	(comolefue 0)
;	?p <- (campeon (nombre ?**))
;=>
;	(modify ?p (- prioridad 1))
;)
;(defrule como-le-fue
;(declare salience 186)
;	(initial-fact)
;=>
;	(printout t "Le fue bien? si o no: ")
;	(assert (comolefue =(readline)))
;)
; ORDEN DE ELECCION
; 1a
; 1m
; 2m
; 2a
; 3a
; 3m
; 4m
; 4a
; 5a
; 5m

(defrule prioridad-gw
  (declare (salience 198)); mas alto que los ingreso-#equipo
  (juega-con ?jugador ?equipo ?campeon)
  ?f0 <- (prioridad (tipo "gw") (champ1 ?campeon) (champ2 ?gw) (flag 0))
  (juega-con ?jug&~?jugador ?equipo ?gw) ; existe el gw en su equipo
  ?f1 <- (campeon (nombre ?campeon) (prioridad ?prioridad))
=>
  (modify ?f0 (flag 1))
  (modify ?f1 (prioridad (+ ?prioridad 1)))
  (printout t "Subiendo prioridad a " ?campeon " de jugador " ?jugador " y equipo " ?equipo " porque es gw con " ?gw crlf)
)
(defrule prioridad-ga
  (declare (salience 198)); mas alto que los ingreso-#equipo
  (juega-con ?jugador ?equipo ?campeon)
  ?f0 <- (prioridad (tipo "ga") (champ1 ?campeon) (champ2 ?ga) (flag 0))
  (juega-con ?jug ?equi&~?equipo ?ga) ; no existe el ga en su equipo
  ?f1 <- (campeon (nombre ?campeon) (prioridad ?prioridad))
=>
  (modify ?f0 (flag 1))
  (modify ?f1 (prioridad (+ ?prioridad 1)))
  (printout t "Subiendo prioridad a " ?campeon " de jugador " ?jugador " y equipo " ?equipo " porque es ga con " ?ga crlf)
)
(defrule prioridad-ba
  (declare (salience 198)); mas alto que los ingreso-#equipo
  (juega-con ?jugador ?equipo ?campeon)
  ?f0 <- (prioridad (tipo "ba") (champ1 ?campeon) (champ2 ?ba) (flag 0))
  (juega-con ?jug ?equi&~?equipo ?ba) ; no existe el ba en su equipo
  ?f1 <- (campeon (nombre ?campeon) (prioridad ?prioridad))
=>
  (modify ?f0 (flag 1))
  (modify ?f1 (prioridad (+ ?prioridad 1)))
  (printout t "Restando prioridad a " ?campeon " de jugador " ?jugador " y equipo " ?equipo " porque es ba con " ?ba crlf)
)
(defrule ingreso-campeon-fase2
  (declare (salience 199)); mas alto que los ingreso-#equipo
  (con-posicion ?jugador ?equipo ?pos)
=>
  (printout t crlf "Top 3 Campeones Recomendados:" crlf)
  (printout t (implode$ (subseq$ ?*candidatos* 1 3)) crlf)
  (bind ?*candidatos* 0) ; limpiar la lista
  (bind ?*prioridades* 0) ; limpiar la lista
  (printout t "Ingrese nombre del campeon: ")
  (bind ?campeon (readline))
  (assert (juega-con ?jugador ?equipo ?campeon))
  (if (integerp ?*campeones*)
    then ; eliminar el campo 0
      (bind ?*campeones* ?*campeones* ?campeon)
      (bind ?*equipos* ?*equipos* ?equipo)
      (bind ?*campeones*   (delete$ ?*campeones*  1 1))
      (bind ?*equipos*  (delete$ ?*equipos* 1 1))
    else ; ingreso normal
      (bind ?*campeones* ?*campeones* ?campeon)
      (bind ?*equipos* ?*equipos* ?equipo)
  )
  (assert (ban ?campeon)) ; ya no se podra elegir
  (printout t crlf)
)
(defrule ingreso-campeon
  (declare (salience 200)); mas alto que los ingreso-#equipo
  (con-posicion ?jugador ?equipo ?pos)(tiene-codigo ?posicion ?pos)
  (puede-con ?pos $?rols)

  (campeon
    (nombre ?campeon)
    (tiene-rols ?r1 ?r2
      &:(or (member ?r1 $?rols)(member ?r2 $?rols))
    )
    (prioridad ?prioridad)
    (gw $?allgw)
    (ga $?allga)
    (ba $?allba)
    (ban 0)
  )
  ;(juega-con ? ?&~?nombre)
=>
  (if (integerp ?*candidatos*)
    then
      (bind ?*candidatos* ?*candidatos* ?campeon)
      (bind ?*prioridades* ?*prioridades* ?prioridad)
      (bind ?*candidatos*   (delete$ ?*candidatos*  1 1))
      (bind ?*prioridades*  (delete$ ?*prioridades* 1 1))
      ;(printout t "ELIMINANDO" crlf)
    else ; ingrese ordenado segun prioridad
      ; antes, modificar prioridad a causa de campeones elegidos anteriormente
      (bind ?pri ?prioridad); la prioridad a modificar del candidato
      (if (not (integerp ?*campeones*)) ; por lo menos ya se ha elegido el primer campeon
        then
          (bind ?len (length$ ?*campeones*))
          (loop-for-count (?a 1 ?len); iterar los campeones ya elegidos (maximo 9)
            (bind ?chosenChamp (nth$ ?a ?*campeones*)) ; nombre de campeon elegido
            (bind ?chosenTeam (nth$ ?a ?*equipos*)) ; equipo que elegio el campeon
            (loop-for-count (?i 1 10); iterar por gw ga ba del campeon candidato
              (bind ?igw (nth$ ?i $?allgw))
              (bind ?iga (nth$ ?i $?allga))
              (bind ?iba (nth$ ?i $?allba))

              (if (and (eq ?igw ?chosenChamp)(eq ?chosenTeam ?equipo))
                then (bind ?pri (+ ?pri 1)); sumar prioridad
                ;(printout t "sumando gw" crlf)
                else
                  (if (and (eq ?iga ?chosenChamp)(neq ?chosenTeam ?equipo))
                    then (bind ?pri (+ ?pri 1)); sumar prioridad
                      ;(printout t "sumando ga" crlf)
                    else
                      (if (and (eq ?iba ?chosenChamp)(neq ?chosenTeam ?equipo))
                        then (bind ?pri (- ?pri 1)); restar prioridad
                        ;(printout t "sumando ba" crlf)
                      )
                  )
              )
            )
          )
      )
      ; ahora si, el ingreso ordenado
      (bind ?length (length$ ?*candidatos*))
      (bind ?nswapped True)
      (loop-for-count (?x 1 ?length)
          (bind ?prioridadLista (nth$ ?x ?*prioridades*))
          (if (>= ?pri ?prioridadLista)
            then
              ; make the swap happen :)
              (bind ?*candidatos* (insert$ ?*candidatos* ?x ?campeon))
              (bind ?*prioridades* (insert$ ?*prioridades* ?x ?pri))
              (bind ?nswapped False)
              ;(printout t "ROMPIENDO" crlf)
              (break)
          )
      )
      (if (eq ?nswapped True)
        then ; anadir al final de la lista
          (bind ?*candidatos* ?*candidatos* ?campeon)
          (bind ?*prioridades* ?*prioridades* ?pri)
      )
  )
  ;(printout t crlf "== " ?jugador " == " ?posicion " == " $?rols " == " ?r1 " == " ?r2 " == " ?campeon " == prioridad " ?prioridad  crlf crlf)
)
(defrule ingreso-5m
  (declare (salience 190))
  (jugador 5 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 5 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 5 "m" ?pos))
)
(defrule ingreso-5a
  (declare (salience 190))
  (jugador 5 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 5 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 5 "a" ?pos))
  (assert (jugador 5 "m")) ; proximo jugador que elije
)
(defrule ingreso-4a
  (declare (salience 190))
  (jugador 4 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 4 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 4 "a" ?pos))
  (assert (jugador 5 "a")) ; proximo jugador que elije
)
(defrule ingreso-4m
  (declare (salience 190))
  (jugador 4 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 4 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 4 "m" ?pos))
  (assert (jugador 4 "a")) ; proximo jugador que elije
)
(defrule ingreso-3m
  (declare (salience 190))
  (jugador 3 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 3 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 3 "m" ?pos))
  (assert (jugador 4 "m")) ; proximo jugador que elije
)
(defrule ingreso-3a
  (declare (salience 190))
  (jugador 3 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 3 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 3 "a" ?pos))
  (assert (jugador 3 "m")) ; proximo jugador que elije
)
(defrule ingreso-2a
  (declare (salience 190))
  (jugador 2 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 2 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 2 "a" ?pos))
  (assert (jugador 3 "a")) ; proximo jugador que elije
)
(defrule ingreso-2m
  (declare (salience 190))
  (jugador 2 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 2 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 2 "m" ?pos))
  (assert (jugador 2 "a")) ; proximo jugador que elije
)
(defrule ingreso-1m
  (declare (salience 190))
  (jugador 1 "m")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 1 de Equipo Morado, Elija su posicion: ")
  (bind ?pos (read))
  (assert(con-posicion 1 "m" ?pos))
  (assert (jugador 2 "m")) ; proximo jugador que elije
)
(defrule ingreso-1a
  (declare (salience 190))
  (jugador 1 "a")
=>
  (printout t crlf "ELECCION DE POSICION" crlf "Posiciones disponibles:" crlf
    "1. Top" crlf "2. Mid" crlf "3. ADC" crlf "4. Support" crlf "5. Jungle" crlf
    "Jugador 1 de Equipo Azul, Elija su posicion: ")
  (bind ?pos (read))
  (assert (jugador 1 "m")) ; proximo jugador que elije
  (assert(con-posicion 1 "a" ?pos))
)
(defrule trato-ban
(declare (salience 201))
  ?b <- (ban ?campeon)
  ?p <- (campeon (nombre ?campeon) (ban 0))
=>
  (modify ?p (ban 1))
  (retract ?b)
)
(defrule ingreso-informacion1
(declare (salience 201))
   (initial-fact)
=>
	(printout t "Modo Blind-Pick" crlf)

	;(assert (flag201 1))
  (assert (ban "Irelia"))
  (assert (ban "Janna"))
  (assert (ban "Jarvan IV"))
  (assert (ban "Jax"))
  (assert (ban "Jayce"))
  (assert (ban "Jinx"))

	(printout t crlf "Ingrese equipo a pertener, Azul o Morado: ")
	(bind ?*equipo* Azul)

	(printout t crlf "Ingrese el # de jugador (1 - 6) del equipo " ?*equipo* ": ")
	(bind ?*player* 1)
	(printout t crlf)
  (assert (jugador 1 "a")) ; proximo jugador que elije
)
(defrule inicio
(declare (salience 202))
  (initial-fact)
=>
  (load-facts limited_facts.clp)
	;(printout t " Exito!!, Se cargaron los datos correctamente" crlf crlf )
)


application/tools/conv/gl/common/Application.clp: Fixed imports

All of the modules have had (import init ?ALL) added to include support for the
init module features

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; CommonConversionEntry.clp - Entry point into the generic backend for the
;                             conversion expert systems
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
; Load cortex
;------------------------------------------------------------------------------
(defmodule types
           (import init ?ALL)
           (import cortex ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
(defmodule read-input
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule modify-input
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule identify-lines
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule convert-templates
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule build-groups
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule grouping-update
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule MAIN
           (import init ?ALL)
           (import cortex ?ALL)
           (import types ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
(load-library "tools/conv/gl/common")
(load-logic "tools/conv/gl/common")

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; CommonConversionEntry.clp - Entry point into the generic backend for the
;                             conversion expert systems
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
; Load cortex
;------------------------------------------------------------------------------
(defmodule types
           (import cortex ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
(defmodule read-input
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule modify-input
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule identify-lines
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule convert-templates
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule build-groups
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule grouping-update
           (import cortex ?ALL)
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule MAIN
           (import cortex ?ALL)
           (import types ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
(load-library "tools/conv/gl/common")
(load-logic "tools/conv/gl/common")


Ignore previous timer when it is reset.

Ignore previous timer when it is reset.

-> Implemented a few rules to ignore a timer when a new one is set.
	'-> The only drawback is that if the new one has a shorter time, it will still wait until the longest time ends.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;			GLOBALS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defglobal ?*outlog* = t)
(defglobal ?*logLevel* = ERROR) ; INFO | WARNING | ERROR | DEBUG (print always)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;			FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deffunction log-message
	; Receives level and message chunks that would be concatenated.
	; Level is one of: INFO | WARNING | ERROR | DEBUG (print always)
	(?level ?msg1 $?msg2)

	(bind ?message ?msg1)
	(progn$ (?var $?msg2)
		(bind ?message (str-cat ?message ?var) )
	)
	(if (eq ?level DEBUG) then
		(printout ?*outlog* ?level ": " ?message crlf)
		(return)
	)
	(bind ?currentLogLevel 10)
	(bind ?lvl 10)
	(switch ?*logLevel*
		(case INFO then (bind ?currentLogLevel 0))
		(case ERROR then (bind ?currentLogLevel 20))
		(case WARNING then (bind ?currentLogLevel 10))
	)
	(switch ?level
		(case INFO then (bind ?lvl 0))
		(case ERROR then (bind ?lvl 20))
		(case WARNING then (bind ?lvl 10))
	)
	(if (>= ?lvl ?currentLogLevel) then
		(printout ?*outlog* ?level ": " ?message crlf)
	)
)

(deffunction str-replace
	(?str ?old ?new)
	(bind ?len (str-length ?old))
	(bind ?pos (str-index ?old ?str))
	(while (neq ?pos FALSE) do
		(bind ?str_len (str-length ?str))
		(bind ?str
			(str-cat
				(sub-string 1 (- ?pos 1) ?str)
				?new
				(sub-string (+ ?pos ?len) ?str_len ?str)
			)
		)
		(bind ?pos (str-index ?old ?str))
	)
	(return ?str)
)

(deffunction setCmdTimer
	(?time ?cmd ?id)
	(python-call setCmdTimer ?time ?cmd ?id)
)

(deffunction setTimer
	; Receives time in miliseconds and a symbol to identify fact that indicates the timer ran off.
	(?time ?sym)
	(bind ?new_sym (gensym*))
	(python-call setTimer ?time ?new_sym)
	(assert
		(BBCLIPS_timer ?new_sym ?sym)
		(timer_sent ?sym)
	)
)

(defrule clear_timers
	(declare (salience -9501))
	?t <-(BB_timer $?)
	=>
	(retract ?t)
)

(defrule timer_alarm
	(declare (salience 10000))
	?bbt <-(BB_timer ?new_sym)
	?bbct <-(BBCLIPS_timer ?new_sym ?sym)
	(not (BBCLIPS_timer ~?new_sym ?sym))
	?t <-(timer_sent ?sym)
	=>
	(retract ?t ?bbt ?bbct)
	(assert
		(BB_timer ?sym)
	)
)

(defrule timer_alarm-old_timer
	(declare (salience 10000))
	?bbt <-(BB_timer ?new_sym)
	?bbct <-(BBCLIPS_timer ?new_sym ?sym)
	;(timer_sent ?sym)
	(BBCLIPS_timer ~?new_sym ?sym)
	=>
	(retract ?bbt ?bbct)
)

(deffunction sleep
	; Receives time in miliseconds.
	; Prevents python from running during that time, even when messages are received.
	(?ms)
	(bind ?sym (gensym*))
	(python-call sleep ?ms ?sym)
	(halt)
)

(deffunction stop
	()
	(log-message WARNING "Stop function called. EXECUTION HALTED.")
	(python-call stop)
	(halt)
)

(deffunction set_delete
	(?fact ?time_in_secs)
	(bind ?sym (gensym*))
	(setTimer (* ?time_in_secs 1000) ?sym)
	(assert
		(BB_set_delete ?fact ?sym)
	)
)

(defrule set_delete-delete_fact
	(BB_timer ?sym)
	?f <-(BB_set_delete ?fact ?sym)
	(test (fact-existp ?fact))
	=>
	(retract ?f ?fact)
)

(defrule set_delete-delete_delete_flag
	(BB_timer ?sym)
	?f <-(BB_set_delete ?fact ?sym)
	(not (test (fact-existp ?fact)))
	=>
	(retract ?f)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;			GLOBALS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defglobal ?*outlog* = t)
(defglobal ?*logLevel* = ERROR) ; INFO | WARNING | ERROR | DEBUG (print always)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;			FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deffunction log-message
	; Receives level and message chunks that would be concatenated.
	; Level is one of: INFO | WARNING | ERROR | DEBUG (print always)
	(?level ?msg1 $?msg2)

	(bind ?message ?msg1)
	(progn$ (?var $?msg2)
		(bind ?message (str-cat ?message ?var) )
	)
	(if (eq ?level DEBUG) then
		(printout ?*outlog* ?level ": " ?message crlf)
		(return)
	)
	(bind ?currentLogLevel 10)
	(bind ?lvl 10)
	(switch ?*logLevel*
		(case INFO then (bind ?currentLogLevel 0))
		(case ERROR then (bind ?currentLogLevel 20))
		(case WARNING then (bind ?currentLogLevel 10))
	)
	(switch ?level
		(case INFO then (bind ?lvl 0))
		(case ERROR then (bind ?lvl 20))
		(case WARNING then (bind ?lvl 10))
	)
	(if (>= ?lvl ?currentLogLevel) then
		(printout ?*outlog* ?level ": " ?message crlf)
	)
)

(deffunction str-replace
	(?str ?old ?new)
	(bind ?len (str-length ?old))
	(bind ?pos (str-index ?old ?str))
	(while (neq ?pos FALSE) do
		(bind ?str_len (str-length ?str))
		(bind ?str
			(str-cat
				(sub-string 1 (- ?pos 1) ?str)
				?new
				(sub-string (+ ?pos ?len) ?str_len ?str)
			)
		)
		(bind ?pos (str-index ?old ?str))
	)
	(return ?str)
)

(deffunction setCmdTimer
	(?time ?cmd ?id)
	(python-call setCmdTimer ?time ?cmd ?id)
)

(deffunction setTimer
	; Receives time in miliseconds and a symbol to identify fact that indicates the timer ran off.
	(?time ?sym)
	(python-call setTimer ?time ?sym)
	(assert (timer_sent ?sym) )
)

(defrule clear_timers
	(declare (salience -9501))
	?t <-(BB_timer $?)
	=>
	(retract ?t)
)

(defrule delete_timer_sent
	(declare (salience 10000))
	(BB_timer ?sym)
	?t <-(timer_sent ?sym)
	=>
	(retract ?t)
)

(defrule delete_timer
	(declare (salience -9501))
	?t <-(BB_timer ?sym)
	(not (timer_sent ?sym))
	=>
	(retract ?t)
)

(deffunction sleep
	; Receives time in miliseconds.
	; Prevents python from running during that time, even when messages are received.
	(?ms)
	(bind ?sym (gensym*))
	(python-call sleep ?ms ?sym)
	(halt)
)

(deffunction stop
	()
	(log-message WARNING "Stop function called. EXECUTION HALTED.")
	(python-call stop)
	(halt)
)

(deffunction set_delete
	(?fact ?time_in_secs)
	(bind ?sym (gensym*))
	(setTimer (* ?time_in_secs 1000) ?sym)
	(assert
		(BB_set_delete ?fact ?sym)
	)
)

(defrule set_delete-delete_fact
	(BB_timer ?sym)
	?f <-(BB_set_delete ?fact ?sym)
	(test (fact-existp ?fact))
	=>
	(retract ?f ?fact)
)

(defrule set_delete-delete_delete_flag
	(BB_timer ?sym)
	?f <-(BB_set_delete ?fact ?sym)
	(not (test (fact-existp ?fact)))
	=>
	(retract ?f)
)


Update task2.clp

Update task2.clp

(deffacts tovars
    (tovar TV 200 4 2015 Russia)
    (tovar Watch 199 5 2017 USA)
    (tovar Linkorn 1000 1 2010 Armenia)
    (tovar IceCream 10 99 2017 Ukraine)
    (tovar Book 1 1 2001 Vanuatu)
)

(defrule ucenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (or (< ?year 2010)
              (< ?count 4)
          )
    )
     =>
     (assert (ucenka ?name (* ?cost 0.15)))
)

(defrule nacenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (and (= 0 (str-compare ?country Russia))
               (= ?year 2017)
          )
    )
     =>
    (assert (nacenka ?name (* ?cost 0.07)))
)

(defrule russian
    (tovar ?name ?cost ?count ?year ?country)

    (exists  (test (= 0 (str-compare ?country Russia))))
      =>
    (printout t "There are Russian production" crlf)
)

(deffacts tovars
    (tovar TV 200 4 2015 Russia)
    (tovar Watch 199 5 2017 USA)
    (tovar Linkorn 1000 1 2010 Russia)
    (tovar IceCream 10 99 2017 Ukraine)
    (tovar Book 1 1 2001 Vanuatu)
)

(defrule ucenk
    (tovar ?name ?cost ?count ?year ?country)

    (test (or (?year < 2010)
              (?count < 4)
          )
    )
     =>
     (assert (ucenka ?name (* ?cost 0.15)))
)


Modified the slots of Path to be lower case

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Path.clp - Contains the definition of the pass class
;------------------------------------------------------------------------------
(defclass types::Path
  (is-a ParentedHint)
  (slot exit (type SYMBOL))
  (slot closed (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(defmessage-handler types::Path init after
 ()
 (bind ?self:Type Path))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Path.clp - Contains the definition of the pass class
;------------------------------------------------------------------------------
(defclass types::Path
  (is-a ParentedHint)
  (slot Exit (type SYMBOL))
  (slot Closed (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(defmessage-handler types::Path init after
 ()
 (bind ?self:Type Path))
;------------------------------------------------------------------------------


Added a control fact to each rule in PathTraversal.clp

This control fact is used to traverse each path in a region as well as be
mutated to handle path building as well.

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; PathTraversal.clp - Contains rules that handle the act of traversing the
; region during path construction. Modified to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-basicblock
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path) (id ?id)
                          (parent ?p)
                          (closed FALSE)
                          (values $?before ?curr))
         (object (is-a BasicBlock)
                 (id ?curr)
                 (parent ?p)
                 (Successors $? ?next $?))
         (object (is-a BasicBlock)
                 (id ?next)
                 (parent ?p))
         (test (and (neq ?next ?curr)
                    (not (member$ ?next $?before))))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action add-to-path)
                 (arguments ?next => ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-basicblock
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $?before ?curr))
         (object (is-a Region)
                 (id ?curr)
                 (parent ?p)
                 (Exits $? ?next $?))
         (object (is-a BasicBlock)
                 (id ?next)
                 (parent ?p))
         (test (and (neq ?next ?curr)
                    (not (member$ ?next $?before))))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action add-to-path)
                 (arguments ?next => ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-region
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $?before ?curr))
         (object (is-a BasicBlock)
                 (id ?curr)
                 (parent ?p)
                 (Successors $? ?s $?))
         (object (is-a Region)
                 (Entrances $? ?s $?)
                 (id ?next)
                 (parent ?p))
         (test (and (neq ?next ?curr)
                    (not (member$ ?next $?before))))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action add-to-path)
                 (arguments ?next => ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-region
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $?before ?curr))
         (object (is-a Region)
                 (id ?curr)
                 (parent ?p)
                 (Exits $? ?e $?))
         (object (is-a Region)
                 (id ?next)
                 (parent ?p)
                 (Entrances $? ?e $?))
         (test (and (neq ?next ?curr)
                    (not (member$ ?next $?before))))
         ; even if the entrance is part of a nested region...we really don't
         ; care it will still be accurate thanks to the way llvm does things
         =>
         (send ?path increment-reference-count)
         (modify ?f (action add-to-path)
                 (arguments ?next => ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-no-exit
         "We are at a region that doesn't have an exit...Not sure if LLVM
         allows this but let's handle it."
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (parent ?p)
                          (closed FALSE)
                          (values $? ?a))
         (object (is-a Region)
                 (id ?a)
                 (parent ?p)
                 (Exits))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => nil)))
;------------------------------------------------------------------------------
(defrule paths-conditional::travseral-basicblock-no-exit
         "We are at a basic block that has no successors...usually the end of a
         function"
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (parent ?p)
                          (closed FALSE)
                          (values $? ?a))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?p)
                 (Successors))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => nil)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-basicblock-cycle
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path) (id ?id)
                          (parent ?p)
                          (values $?before ?curr)
                          (closed FALSE))
         (object (is-a BasicBlock)
                 (id ?curr)
                 (parent ?p)
                 (Successors $? ?next $?))
         (object (is-a BasicBlock)
                 (id ?next)
                 (parent ?p))
         (test (or (eq ?next ?curr)
                   (member$ ?next $?before)))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => ?next)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-basicblock-cycle
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path) (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $?before ?curr))
         (object (is-a Region)
                 (id ?curr)
                 (parent ?p)
                 (Exits $? ?next $?))
         (object (is-a BasicBlock)
                 (id ?next)
                 (parent ?p))
         (test (or (eq ?next ?curr)
                   (member$ ?next $?before)))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => ?next)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-region-cycle
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $?before ?curr))
         (object (is-a BasicBlock)
                 (id ?curr)
                 (parent ?p)
                 (Successors $? ?s $?))
         (object (is-a Region)
                 (id ?next)
                 (parent ?p)
                 (Entrances $? ?s $?))
         (test (or (eq ?next ?curr)
                   (member$ ?next $?before)))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => ?next)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-region-cycle
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $?before ?curr))
         (object (is-a Region)
                 (id ?curr)
                 (parent ?p)
                 (Exits $? ?e $?))
         (object (is-a Region)
                 (id ?next)
                 (parent ?p)
                 (Entrances $? ?e $?))
         (test (or (eq ?next ?curr)
                   (member$ ?next $?before)))
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?next => ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-exit
         "Marks the current path as finished because we've reached an exit to
         the current region"
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (parent ?p)
                          (closed FALSE)
                          (values $? ?curr))
         (object (is-a BasicBlock)
                 (id ?curr)
                 (parent ?p)
                 (Successors $? ?e $?))
         (object (is-a Region)
                 (id ?p)
                 (Exits $? ?e $?))
         ;since the current block has an exit for this region we mark it
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => ?e)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-exit
         (declare (salience 2))
         ?f <- (message (to paths-conditional)
                        (action build-path)
                        (arguments ?id))
         ?path <- (object (is-a Path)
                          (id ?id)
                          (closed FALSE)
                          (parent ?p)
                          (values $? ?c))
         (object (is-a Region)
                 (id ?c)
                 (parent ?p)
                 (Exits $? ?e $?))
         (object (is-a Region)
                 (id ?p)
                 (Exits $? ?e $?))
         ; both the inner and outer regions have the same exit...thus the
         ; curent nested region is a terminator for one path
         =>
         (send ?path increment-reference-count)
         (modify ?f (action close-path)
                 (arguments ?id => ?e)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; PathTraversal.clp - Contains rules that handle the act of traversing the
; region during path construction. Modified to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-basicblock
			(declare (salience 2))
			?path <- (object (is-a Path) (parent ?p) (id ?id)
								  (values $?before ?curr) (closed FALSE))
			(object (is-a BasicBlock) (id ?curr) (parent ?p)
					  (Successors $? ?next $?))
			(object (is-a BasicBlock) (id ?next) (parent ?p))
			(test (and (neq ?next ?curr)
					     (not (member$ ?next $?before))))
			=>
			(send ?path increment-reference-count)
			(assert (Add ?next to ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-basicblock
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $?before ?curr))
			(object (is-a Region) (id ?curr) (parent ?p) (Exits $? ?next $?))
			(object (is-a BasicBlock) (id ?next) (parent ?p))
			(test (and (neq ?next ?curr)
					     (not (member$ ?next $?before))))
			=>
			(send ?path increment-reference-count)
			(assert (Add ?next to ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-region
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $?before ?curr))
			(object (is-a BasicBlock) (id ?curr) (parent ?p)
					  (Successors $? ?s $?))
			(object (is-a Region) (Entrances $? ?s $?) (id ?next) (parent ?p))
			(test (and (neq ?next ?curr)
					     (not (member$ ?next $?before))))
			=>
			(send ?path increment-reference-count)
			(assert (Add ?next to ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-region
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $?before ?curr))
			(object (is-a Region) (id ?curr) (parent ?p) (Exits $? ?e $?))
			(object (is-a Region) (id ?next) (parent ?p) (Entrances $? ?e $?))
			(test (and (neq ?next ?curr)
					     (not (member$ ?next $?before))))
			; even if the entrance is part of a nested region...we really don't
			; care it will still be accurate thanks to the way llvm does things
			=>
			(send ?path increment-reference-count)
			(assert (Add ?next to ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-no-exit
			"We are at a region that doesn't have an exit...Not sure if LLVM
			allows this but let's handle it."
			(declare (salience 2))
			?path <- (object (is-a Path) (parent ?p) (id ?i) (closed FALSE)
								  (values $? ?a))
			(object (is-a Region) (id ?a) (parent ?p) (Exits))
			=>
			(send ?path increment-reference-count)
			(assert (Close ?i with nil)))
;------------------------------------------------------------------------------
(defrule paths-conditional::travseral-basicblock-no-exit
			"We are at a basic block that has no successors...usually the end of a
			function"
			(declare (salience 2))
			?path <- (object (is-a Path) (parent ?p) (id ?i) (closed FALSE)
								  (values $? ?a))
			(object (is-a BasicBlock) (id ?a) (parent ?p) (Successors))
			=>
			(send ?path increment-reference-count)
			(assert (Close ?i with nil)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-basicblock-cycle
			(declare (salience 2))
			?path <- (object (is-a Path) (parent ?p) (id ?id)
								  (values $?before ?curr) (closed FALSE))
			(object (is-a BasicBlock) (id ?curr) (parent ?p)
					  (Successors $? ?next $?))
			(object (is-a BasicBlock) (id ?next) (parent ?p))
			(test (or (eq ?next ?curr) (member$ ?next $?before)))
			=>
			(send ?path increment-reference-count)
			(assert (Close ?id with ?next)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-basicblock-cycle
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $?before ?curr))
			(object (is-a Region) (id ?curr) (parent ?p) (Exits $? ?next $?))
			(object (is-a BasicBlock) (id ?next) (parent ?p))
			(test (or (eq ?next ?curr) (member$ ?next $?before)))
			=>
			(send ?path increment-reference-count)
			(assert (Close ?id with ?next)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-region-cycle
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $?before ?curr))
			(object (is-a BasicBlock) (id ?curr) (parent ?p) (Successors $? ?s $?))
			(object (is-a Region) (id ?next) (parent ?p) (Entrances $? ?s $?))
			(test (or (eq ?next ?curr) (member$ ?next $?before)))
			=>
			(send ?path increment-reference-count)
			(assert (Close ?id with ?next)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-region-cycle
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $?before ?curr))
			(object (is-a Region) (id ?curr) (parent ?p) (Exits $? ?e $?))
			(object (is-a Region) (id ?next) (parent ?p) (Entrances $? ?e $?))
			(test (or (eq ?next ?curr) (member$ ?next $?before)))
			=>
			(send ?path increment-reference-count)
			(assert (Close ?next with ?id)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-basicblock-to-exit
			"Marks the current path as finished because we've reached an exit to
			the current region"
			(declare (salience 2))
			?path <- (object (is-a Path) (parent ?p) (id ?id) (values $? ?curr)
								  (closed FALSE))
			(object (is-a BasicBlock) (id ?curr) (parent ?p) (Successors $? ?e $?))
			(object (is-a Region) (id ?p) (Exits $? ?e $?))
			;since the current block has an exit for this region we mark it
			=>
			(send ?path increment-reference-count)
			(assert (Close ?id with ?e)))
;------------------------------------------------------------------------------
(defrule paths-conditional::traversal-region-to-exit
			(declare (salience 2))
			?path <- (object (is-a Path) (closed FALSE) (parent ?p) (id ?id)
								  (values $? ?c))
			(object (is-a Region) (id ?c) (parent ?p) (Exits $? ?e $?))
			(object (is-a Region) (id ?p) (Exits $? ?e $?))
			; both the inner and outer regions have the same exit...thus the
			; curent nested region is a terminator for one path
			=>
			(send ?path increment-reference-count)
			(assert (Close ?id with ?e)))
;------------------------------------------------------------------------------