Fixed a bug in MergeRules.clp

Fixed a bug in MergeRules.clp

The data for producers and consumers were being stored in the wrong multislots
(they were flipped). This has been corrected.

;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.
;------------------------------------------------------------------------------
; MergeRules.clp - Contains all of the merge rules used in the analysis stages
; Written by Joshua Scoggins (11/18/2012)
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0)
			(modify ?f1 (action instruction-consume-list)
					  (arguments ?id => ?a ?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0)
			(modify ?f1 (action instruction-produce-list)
					  (arguments ?id => ?a ?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0)
			(modify ?f1 (arguments ?id => $?a $?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0)
			(modify ?f1 (arguments ?id => $?a $?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-consumes)
								(arguments ?a => ?b))
			=>
			(modify ?f (action instruction-consume-list)
					  (arguments ?b => ?a)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-produces)
								(arguments ?a => ?b))
			=>
			(modify ?f (action instruction-produce-list)
					  (arguments ?b => ?a)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers-Producers-And-LocalDependencies
			"Performs the actions of InjectConsumers and
			InjectProducersAndLocalDependencies in a single rule fire."
			(declare (salience 1))
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?t0))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?t1))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?c)
								  (Producers $?p)
								  (LocalDependencies $?ld))
			=>
			(retract ?f0 ?f1)
			(bind ?cs $?c)
			(bind ?ps $?p)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?t1)
						 (if (not (member$ ?target ?cs)) then
							(bind ?cs (insert$ ?cs 1 ?target))))
			  (progn$ (?target ?t0)
						 (if (not (member$ ?target ?lds)) then
							(bind ?lds (insert$ ?lds 1 ?target)))
						 (if (not (member$ ?target ?ps)) then
							(bind ?ps (insert$ ?ps 1 ?target))))
			  (modify-instance ?inst (Consumers ?cs) (Producers ?ps)
									 (LocalDependencies ?lds))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers
			"Adds a given consumer to the target instruction"
			?fct <- (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?cs))
			=>
			(retract ?fct)
			(bind ?cons $?cs)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?cons)) then
							(bind ?cons (insert$ ?cons 1 ?target)))))
			  (modify-instance ?inst (Consumers ?cons)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectProducersAndLocalDependencies
			"Adds a given producer to the target instruction."
			?fct <- (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Producers $?ps)
								  (LocalDependencies $?ld))
			=>
			(retract ?fct)
			(bind ?prods $?ps)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?lds)) then
						   (bind ?lds (create$ ?lds ?target)))
						 (if (not (member$ ?target ?prods)) then
						  (bind ?prods (create$ ?prods ?target)))))
			  (modify-instance ?inst (Producers ?prods) (LocalDependencies ?lds)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionProducers
			?inst <- (object (is-a Instruction)
								  (Producers $?a ?b $?c ?b $?d))
			=>
			;if we find one duplicate instance then just convert the whole thing
			;into a list
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (Producers ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionConsumers
			?inst <- (object (is-a Instruction)
								  (Consumers $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (Consumers ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyLocalDependencies
			?inst <- (object (is-a Instruction)
								  (LocalDependencies $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (LocalDependencies ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyNonLocalDependencies
			?inst <- (object (is-a Instruction)
								  (NonLocalDependencies $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (NonLocalDependencies ?mid)))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
; MergeRules.clp - Contains all of the merge rules used in the analysis stages
; Written by Joshua Scoggins (11/18/2012)
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0)
			(modify ?f1 (action instruction-consume-list)
					  (arguments ?id => ?a ?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0)
			(modify ?f1 (action instruction-produce-list)
					  (arguments ?id => ?a ?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0)
			(modify ?f1 (arguments ?id => $?a $?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0)
			(modify ?f1 (arguments ?id => $?a $?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-consumes)
								(arguments ?a => ?b))
			=>
			(modify ?f (action instruction-consume-list)
					  (arguments ?b => ?a)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-produces)
								(arguments ?a => ?b))
			=>
			(modify ?f (action instruction-produce-list)
					  (arguments ?b => ?a)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers-Producers-And-LocalDependencies
			"Performs the actions of InjectConsumers and
			InjectProducersAndLocalDependencies in a single rule fire."
			(declare (salience 1))
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?t0))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?t1))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?c)
								  (Producers $?p)
								  (LocalDependencies $?ld))
			=>
			(retract ?f0 ?f1)
			(bind ?cs $?c)
			(bind ?ps $?p)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?t0)
						 (if (not (member$ ?target ?cs)) then
							(bind ?cs (insert$ ?cs 1 ?target))))
			  (progn$ (?target ?t1)
						 (if (not (member$ ?target ?lds)) then
							(bind ?lds (insert$ ?lds 1 ?target)))
						 (if (not (member$ ?target ?ps)) then
							(bind ?ps (insert$ ?ps 1 ?target))))
			  (modify-instance ?inst (Consumers ?cs) (Producers ?ps)
									 (LocalDependencies ?lds))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers
			"Adds a given consumer to the target instruction"
			?fct <- (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?cs))
			=>
			(retract ?fct)
			(bind ?cons $?cs)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?cons)) then
							(bind ?cons (insert$ ?cons 1 ?target)))))
			  (modify-instance ?inst (Consumers ?cons)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectProducersAndLocalDependencies
			"Adds a given producer to the target instruction."
			?fct <- (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Producers $?ps)
								  (LocalDependencies $?ld))
			=>
			(retract ?fct)
			(bind ?prods $?ps)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?lds)) then
						   (bind ?lds (create$ ?lds ?target)))
						 (if (not (member$ ?target ?prods)) then
						  (bind ?prods (create$ ?prods ?target)))))
			  (modify-instance ?inst (Producers ?prods) (LocalDependencies ?lds)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionProducers
			?inst <- (object (is-a Instruction)
								  (Producers $?a ?b $?c ?b $?d))
			=>
			;if we find one duplicate instance then just convert the whole thing
			;into a list
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (Producers ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionConsumers
			?inst <- (object (is-a Instruction)
								  (Consumers $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (Consumers ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyLocalDependencies
			?inst <- (object (is-a Instruction)
								  (LocalDependencies $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (LocalDependencies ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyNonLocalDependencies
			?inst <- (object (is-a Instruction)
								  (NonLocalDependencies $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (NonLocalDependencies ?mid)))
;------------------------------------------------------------------------------


Fixed microcode/input.clp

Fixed microcode/input.clp

Keyboard events should be presented correctly now

(defrule process-mouse-input
         ?f <- (mouse ?a ?b ?c ?d)
         =>
         (retract ?f)
         (format mux "(mouse %d %d %d %d)" ?a ?b ?c ?d))

(defrule keyboard-input
         ?f <- (key ?key)
         =>
         (format t "pressed %d%n" ?key)
         (retract ?f))

(defrule process-mouse-input
         ?f <- (mouse ?a ?b ?c ?d)
         =>
         (retract ?f)
         (format mux "(mouse %d %d %d %d)" ?a ?b ?c ?d))

(defrule keyboard-input
         ?f <- (keyboard ?key)
         =>
         (format t "pressed %d%n" ?key)
         (retract ?f))


Fixed a bug where macro-expand referred to wavefront-determinant

This should be wavefront-scheduling-determinant and has been fixed to reflect
this.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
;this module is used to determine which regions should be targeted for pathing
(defmodule wavefront-scheduling-determinant
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-pre-init
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-code
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-final
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling::macro-expand-passes
			"Pushes the modules that make up this pass into the pass-description"
			?f <- (message (from pipeline)
								(to wavefront-scheduling)
								(action initial-fact))
			?p <- (object (is-a pass-description) (passes $?passes))
			=>
			(retract ?f)
			(modify-instance ?p (passes
										loop-region-merging
										dependency-analysis
										wavefront-scheduling-determinant
										paths-conditional
                    wavefront-scheduling-pre-init
										wavefront-scheduling-code
                    wavefront-scheduling-final
										$?passes)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
;this module is used to determine which regions should be targeted for pathing
(defmodule wavefront-scheduling-determinant
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-pre-init
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-code
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-final
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling::macro-expand-passes
			"Pushes the modules that make up this pass into the pass-description"
			?f <- (message (from pipeline)
								(to wavefront-scheduling)
								(action initial-fact))
			?p <- (object (is-a pass-description) (passes $?passes))
			=>
			(retract ?f)
			(modify-instance ?p (passes
										loop-region-merging
										dependency-analysis
										wavefront-determinant
										paths-conditional
                    wavefront-scheduling-pre-init
										wavefront-scheduling-code
                    wavefront-scheduling-final
										$?passes)))
;------------------------------------------------------------------------------


added some more notes to the assembler

added some more notes to the assembler

;------------------------------------------------------------------------------
;electron
;Copyright (c) 2012-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 The Adventure Engine 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.
;-------------------------------------------------------------------------------
; Assembler.clp - An assembler for the theoretical processor.
;-------------------------------------------------------------------------------
(load* MachineCommon.clp)
;-------------------------------------------------------------------------------
(defglobal MAIN
           ?*symbol-label-instruction* = label
           )
(deffacts macro-instructions
          (instruction (tag ?*symbol-label-instruction*)
                       (arg-count 1)
                       (is-macro TRUE)))
;-------------------------------------------------------------------------------
(deftemplate input-line
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot original-input
                   (type STRING)
                   (default ?NONE))
             (multislot raw-input))
;-------------------------------------------------------------------------------
(deftemplate operation
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot operation
                   (type SYMBOL)
                   (default ?NONE))
             (multislot arguments))
;-------------------------------------------------------------------------------
(defgeneric to-char)
;-------------------------------------------------------------------------------
(defmethod to-char
  ((?i INTEGER (>= ?i 0)) ; no negative numbers
   (?stream SYMBOL))
  (format ?stream "%c" ?i))

(defmethod to-char
  ((?i INTEGER (>= ?i 0)))
  (to-char ?i nil))

;-------------------------------------------------------------------------------
; since we can't do "knowledge construction" in the standard sense we need to
; pull input from standard-in.
;-------------------------------------------------------------------------------
(defrule initialize-assembler
         (initial-fact)
         =>
         (assert (read-to-end 1)))

(defrule build-input-line
         ?f <- (read-to-end ?i)
         =>
         (retract ?f)
         (bind ?input (readline))
         (if (neq ?input EOF) then
           (assert (read-to-end (+ ?i 1))
                   (input-line (line-number ?i)
                               (original-input ?input)
                               (raw-input (explode$ ?input))))
           else
           (assert (translate-input))))

(defrule throw-out-empty-lines
         "remove lines that are completely comments or just plain empty"
         (declare (salience 2))
         ?f <- (input-line (raw-input))
         =>
         (retract ?f))

(defrule invalid-line-found
         (declare (salience 2))
         (input-line (line-number ?i)
                     (original-input ?line)
                     (raw-input $?input))
         (test (> (length$ $?input) 4))
         =>
         (printout werror "ERROR: line " ?i " is invalid" crlf
                   "     " ?line crlf)
         (halt))

(defrule is-invalid-instruction
         (declare (salience 2))
         (input-line (raw-input ?op $?)
                     (line-number ?l)
                     (original-input ?input))
         (not (exists (instruction (tag ?op))))
         =>
         (printout werror
                   (format nil "ERROR: Instruction %s on line %d is invalid%n" ?op ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))
(defrule invalid-argument-count-for-operation
         (declare (salience 2))
         (input-line (raw-input ?operation $?rest)
                     (line-number ?l)
                     (original-input ?input))
         (instruction (tag ?operation)
                      (arg-count ?ac&:(!= ?ac (length$ $?rest))))
         =>
         (printout werror
                   (format nil "ERROR: Invalid number of arguments for %s on line %d%n"
                           ?operation ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))

(defrule process-input-line
         (declare (salience 1)) ; evaluate each line as it goes through
         ?f <- (input-line (raw-input ?operation $?rest)
                           (line-number ?l))
         (instruction (tag ?operation)
                      (arg-count =(length$ $?rest)))

         =>
         (retract ?f)
         (assert (operation (line-number ?l)
                            (operation ?operation)
                            (arguments $?rest))))

;TODO: Build assembly generator
;TODO: Mark labels and data instructions as a way to setup a jump table ahead
;      of time.
;-------------------------------------------------------------------------------
; this becomes a script that reads from standard input
;-------------------------------------------------------------------------------
(reset) ; load the instruction information for our purposes
(run)
(exit)

;------------------------------------------------------------------------------
;electron
;Copyright (c) 2012-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 The Adventure Engine 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.
;-------------------------------------------------------------------------------
; Assembler.clp - An assembler for the theoretical processor.
;-------------------------------------------------------------------------------
(load* MachineCommon.clp)
;-------------------------------------------------------------------------------
(defglobal MAIN
           ?*symbol-label-instruction* = label
           )
(deffacts macro-instructions
          (instruction (tag ?*symbol-label-instruction*)
                       (arg-count 1)
                       (is-macro TRUE)))
;-------------------------------------------------------------------------------
(deftemplate input-line
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot original-input
                   (type STRING)
                   (default ?NONE))
             (multislot raw-input))
;-------------------------------------------------------------------------------
(deftemplate operation
             (slot line-number
                   (type INTEGER)
                   (default ?NONE))
             (slot operation
                   (type SYMBOL)
                   (default ?NONE))
             (multislot arguments))
;-------------------------------------------------------------------------------
(defgeneric to-char)
;-------------------------------------------------------------------------------
(defmethod to-char
  ((?i INTEGER (>= ?i 0)) ; no negative numbers
   (?stream SYMBOL))
  (format ?stream "%c" ?i))

(defmethod to-char
  ((?i INTEGER (>= ?i 0)))
  (to-char ?i nil))

;-------------------------------------------------------------------------------
; since we can't do "knowledge construction" in the standard sense we need to
; pull input from standard-in.
;-------------------------------------------------------------------------------
(defrule initialize-assembler
         (initial-fact)
         =>
         (assert (read-to-end 1)))

(defrule build-input-line
         ?f <- (read-to-end ?i)
         =>
         (retract ?f)
         (bind ?input (readline))
         (if (neq ?input EOF) then
           (assert (read-to-end (+ ?i 1))
                   (input-line (line-number ?i)
                               (original-input ?input)
                               (raw-input (explode$ ?input))))
           else
           (assert (translate-input))))

(defrule throw-out-empty-lines
         "remove lines that are completely comments or just plain empty"
         (declare (salience 2))
         ?f <- (input-line (raw-input))
         =>
         (retract ?f))
(defrule invalid-line-found
         (declare (salience 2))
         (input-line (line-number ?i)
                     (original-input ?line)
                     (raw-input $?input))
         (test (> (length$ $?input) 4))
         =>
         (printout werror "ERROR: line " ?i " is invalid" crlf
                   "     " ?line crlf)
         (halt))

(defrule is-invalid-instruction
         (declare (salience 2))
         (input-line (raw-input ?op $?)
                     (line-number ?l)
                     (original-input ?input))
         (not (exists (instruction (tag ?op))))
         =>
         (printout werror
                   (format nil "ERROR: Instruction %s on line %d is invalid%n" ?op ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))
(defrule invalid-argument-count-for-operation
         (declare (salience 2))
         (input-line (raw-input ?operation $?rest)
                     (line-number ?l)
                     (original-input ?input))
         (instruction (tag ?operation)
                      (arg-count ?ac&:(!= ?ac (length$ $?rest))))
         =>
         (printout werror
                   (format nil "ERROR: Invalid number of arguments for %s on line %d%n"
                           ?operation ?l)
                   (format nil " Line: %s%n%n" ?input))
         (halt))

(defrule process-input-line
         (declare (salience 1)) ; evaluate each line as it goes through
         ?f <- (input-line (raw-input ?operation $?rest)
                           (line-number ?l))
         (instruction (tag ?operation)
                      (arg-count =(length$ $?rest)))

         =>
         (retract ?f)
         (assert (operation (line-number ?l)
                            (operation ?operation)
                            (arguments $?rest))))
;-------------------------------------------------------------------------------
; this becomes a script that reads from standard input
;-------------------------------------------------------------------------------
(reset) ; load the instruction information for our purposes
(run)
(exit)


src/tools/conv/gl/Types/Loader.clp: Removed the loading of Object.clp

This is necessary since Object.clp has been removed

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Loader.clp - Loads all of the corresponding objects
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
(batch* "Types/FileRelated.clp")

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Loader.clp - Loads all of the corresponding objects
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
(batch* "Types/Object.clp")
(batch* "Types/FileRelated.clp")


Fixed a randomized crash issue with determine-indirect-claim

It seems that object-pattern-match-delay will cause intermittent crashes when
it's contents are only modify-instance calls. The significant part about this is
that modify-instance also delays object pattern matching until finished.
Without perusing the associated clips c code, I can only guess that the issue
has to do with multiple layers of indirection being added. Fixing this issue
required me to remove the object-pattern-match-delay command that surrounded
the modify-instance calls.

I also cleaned up the code to look similar to the wavefront scheduling pass
code in terms of formatting.

;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.
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-region
			(object (is-a Region)
					  (id ?r))
			(not (exists (object (is-a OwnershipDeterminant)
										(parent ?r))))
			=>
			(make-instance of OwnershipDeterminant
								(parent ?r)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-basicblock
			(object (is-a BasicBlock)
					  (id ?b))
			(not (exists (object (is-a OwnershipDeterminant)
										(parent ?b))))
			=>
			(make-instance of OwnershipDeterminant
								(parent ?b)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-population::populate-determinant
			?fct <- (message (to loop-region-merging)
								  (action claim-owns)
								  (arguments ?a => ?b))
			?obj <- (object (is-a OwnershipDeterminant)
								 (parent ?b))
			?obj2 <- (object (is-a OwnershipDeterminant)
								  (parent ?a))
			=>
			(retract ?fct)
			(object-pattern-match-delay
			  (slot-insert$ ?obj2 PotentialChildren 1 ?b)
			  (slot-insert$ ?obj Claims 1 ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-resolution::determine-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant)
								(parent ?b)
								(Claims $?v ?a $?x)
								(IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant)
					  (parent ~?b)
					  (PotentialChildren $? ?b $?)
					  (Claims $? ?a $?))
			?t1 <- (object (is-a OwnershipDeterminant)
								(parent ?a)
								(PotentialChildren $?t ?b $?r))
			=>
			;let's see if this is faster
			(modify-instance ?t0 (IndirectClaims ?ic ?a)
								  (Claims ?v ?x))
			(modify-instance ?t1 (PotentialChildren ?t ?r)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-indirect-resolution::determine-indirect-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant)
								(parent ?b)
								(Claims $?l ?a $?x)
								(IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant)
					  (parent ~?b&~?a)
					  (IndirectClaims $? ?a $?)
					  (PotentialChildren $? ?b $?))
			?t1 <- (object (is-a OwnershipDeterminant)
								(parent ?a)
								(PotentialChildren $?z ?b $?q))
			=>
			(modify-instance ?t0 (IndirectClaims ?ic ?a)
								  (Claims ?l ?x))
			(modify-instance ?t1 (PotentialChildren ?z ?q)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::delete-non-existent-references
			?region <- (object (is-a Region)
									 (contents $? ?b $?))
			(not (exists (object (id ?b))))
			=>
			(object-pattern-match-delay
			  (bind ?ind0 (member$ ?b (send ?region get-contents)))
			  (slot-delete$ ?region contents ?ind0 ?ind0)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-region
			(object (is-a OwnershipDeterminant)
					  (parent ?p)
					  (Claims ?a))
			?obj <- (object (is-a Region)
								 (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-basicblock
			(object (is-a OwnershipDeterminant)
					  (parent ?p)
					  (Claims ?a))
			?obj <- (object (is-a BasicBlock)
								 (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::add-new-child-to-target-region
			(object (is-a OwnershipDeterminant)
					  (parent ?p)
					  (PotentialChildren $? ?a $?))
			?region <- (object (is-a Region)
									 (id ?p)
									 (contents $?c))
			(test (not (member$ ?a ?c)))
			=>
			(slot-insert$ ?region contents 1 ?a))
;------------------------------------------------------------------------------
(defrule loop-region-merging-cleanup-merger::cleanup-ownership-determinants
			"Deletes all of the OwnershipDeterminant objects in a single rule
			fire"
			?f0 <- (delete ownership-determinants)
			=>
			(retract ?f0)
			(progn$ (?obj (find-all-instances ((?list OwnershipDeterminant))
														 TRUE))
					  (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-rename::remove-unowned-elements
			"Now that we have figured out and updated ownership claims it is
			necessary to remove leftover entries in other regions"
			?r <- (object (is-a Region)
							  (id ?t)
							  (contents $?a ?b $?c))
			(object (is-a ParentedObject)
					  (id ?b)
					  (parent ~?t))
			=>
			(modify-instance ?r (contents $?a $?c)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-too-many-claims-of-ownership
			(object (is-a OwnershipDeterminant)
					  (parent ?a)
					  (Claims $?z&:(> (length$ ?z) 1))
					  (id ?name))
			=>
			(printout t "ERROR: " ?name " has more than one claim of ownership on"
						 " it!" crlf "The claims are " ?z crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-region
			(object (is-a OwnershipDeterminant)
					  (parent ?a)
					  (Claims)
					  (PotentialChildren $?pc)
					  (IndirectClaims $?ic))
			(object (is-a Region)
					  (id ?a)
					  (IsTopLevelRegion FALSE))
			=>
			(printout t "ERROR: " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-basicblock
			(object (is-a OwnershipDeterminant)
					  (parent ?a)
					  (Claims)
					  (PotentialChildren $?pc)
					  (IndirectClaims $?ic))
			(object (is-a BasicBlock)
					  (id ?a))
			=>
			(printout t "ERROR: BasicBlock " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-region
			(object (is-a Region) (id ?r))
			(not (exists (object (is-a OwnershipDeterminant) (parent ?r))))
			=>
			(make-instance of OwnershipDeterminant (parent ?r)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-basicblock
			(object (is-a BasicBlock) (id ?b))
			(not (exists (object (is-a OwnershipDeterminant) (parent ?b))))
			=>
			(make-instance of OwnershipDeterminant (parent ?b)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-population::populate-determinant
 			?fct <- (message (to loop-region-merging)
				(action claim-owns)
				(arguments ?a => ?b))
			?obj <- (object (is-a OwnershipDeterminant) (parent ?b))
			?obj2 <- (object (is-a OwnershipDeterminant) (parent ?a))
			=>
			(retract ?fct)
      (object-pattern-match-delay
			(slot-insert$ ?obj2 PotentialChildren 1 ?b)
			(slot-insert$ ?obj Claims 1 ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-resolution::determine-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant) (parent ?b)
								(Claims $?v ?a $?x) (IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant) (parent ~?b)
					  (PotentialChildren $? ?b $?) (Claims $? ?a $?))
			?t1 <- (object (is-a OwnershipDeterminant) (parent ?a)
								(PotentialChildren $?t ?b $?r))
			=>
			;let's see if this is faster
      (object-pattern-match-delay
      (modify-instance ?t0 (IndirectClaims ?ic ?a) (Claims ?v ?x))
      (modify-instance ?t1 (PotentialChildren ?t ?r))))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-indirect-resolution::determine-indirect-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant) (parent ?b)
								(Claims $?l ?a $?x) (IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant) (parent ~?b&~?a)
					  (IndirectClaims $? ?a $?) (PotentialChildren $? ?b $?))
			?t1 <- (object (is-a OwnershipDeterminant) (parent ?a)
								(PotentialChildren $?z ?b $?q))
			=>
      (object-pattern-match-delay
       (modify-instance ?t0 (IndirectClaims ?ic ?a) (Claims ?l ?x))
       (modify-instance ?t1 (PotentialChildren ?z ?q))))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::delete-non-existent-references
			?region <- (object (is-a Region) (contents $? ?b $?))
			(not (exists (object (id ?b))))
			=>
      (object-pattern-match-delay
			(bind ?ind0 (member$ ?b (send ?region get-contents)))
			(slot-delete$ ?region contents ?ind0 ?ind0)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-region
			(object (is-a OwnershipDeterminant) (parent ?p) (Claims ?a))
			?obj <- (object (is-a Region) (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-basicblock
			(object (is-a OwnershipDeterminant) (parent ?p)
					  (Claims ?a))
			?obj <- (object (is-a BasicBlock) (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::add-new-child-to-target-region
			(object (is-a OwnershipDeterminant) (parent ?p)
					  (PotentialChildren $? ?a $?))
			?region <- (object (is-a Region) (id ?p) (contents $?c))
      (test (not (member$ ?a ?c)))
			=>
			(slot-insert$ ?region contents 1 ?a))
;------------------------------------------------------------------------------
(defrule loop-region-merging-cleanup-merger::cleanup-ownership-determinants
			"Deletes all of the OwnershipDeterminant objects in a single rule
			fire"
			?f0 <- (delete ownership-determinants)
			=>
			(retract ?f0)
			(progn$ (?obj (find-all-instances ((?list OwnershipDeterminant))
														 TRUE))
					  (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-rename::remove-unowned-elements
			"Now that we have figured out and updated ownership claims it is
			necessary to remove leftover entries in other regions"
			?r <- (object (is-a Region) (id ?t) (contents $?a ?b $?c))
			(object (is-a ParentedObject) (id ?b) (parent ~?t))
			=>
			(modify-instance ?r (contents $?a $?c)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-too-many-claims-of-ownership
			(object (is-a OwnershipDeterminant) (parent ?a)
					  (Claims $?z&:(> (length$ ?z) 1))
					  (id ?name))
			=>
			(printout t "ERROR: " ?name " has more than one claim of ownership on"
						 " it!" crlf "The claims are " ?z crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-region
			(object (is-a OwnershipDeterminant) (parent ?a) (Claims)
					  (PotentialChildren $?pc) (IndirectClaims $?ic))
			(object (is-a Region) (id ?a) (IsTopLevelRegion FALSE))
			=>
			(printout t "ERROR: " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-basicblock
			(object (is-a OwnershipDeterminant) (parent ?a) (Claims)
					  (PotentialChildren $?pc) (IndirectClaims $?ic))
			(object (is-a BasicBlock) (id ?a))
			=>
			(printout t "ERROR: BasicBlock " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------


Fixed bugs found during testing in WavefrontBlockReopen.clp

I forgot that subtypes of hint use values instead of contents as their storage
multislot.

I also fixed an error in the name of a module for one of the rules

;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.
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::AssertReopenBlocksOnWavefront
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen-blocks)
                          (arguments ?cpv))
         ?obj <- (object (is-a CompensationPathVector)
                         (id ?cpv)
                         (Failures $?failures))
         =>
         (modify-instance ?obj (Failures))
         (modify ?fct (action reopen)
                 (arguments ?cpv => $?failures)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::ReopenBlockOnWavefront
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ?cpv => ?fail $?failures))
         ?wave <- (object (is-a Wavefront)
                          (Closed $?a ?fail $?b)
                          (values $?cnts))
         ?bb <- (object (is-a BasicBlock)
                        (id ?fail)
                        (IsOpen FALSE))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?fail)
                        (InstructionList $?il)
                        (ImpossibleCompensationPathVectors $?icpv))
         =>
         (modify-instance ?bb (IsOpen TRUE))
         (bind ?qs (create$))
         (progn$ (?q ?icpv)
                 (bind ?qObj (instance-address (symbol-to-instance-name ?q)))
                 (bind ?qs (create$ ?qs (send ?qObj get-parent))))
         (modify-instance ?pa (ImpossibleCompensationPathVectors)
                          (InstructionList $?il ?qs)
                          (TargetCompensationPathVectors $?icpv))
         (modify-instance ?wave (contents $?cnts ?fail)
                          (Closed ?a ?b))
         (modify ?fct (arguments ?cpv => $?failures)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::ReaddFailureToCPV
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ?cpv => ?fail $?failures))
         ?wave <- (object (is-a Wavefront)
           (Closed $?c&:(not (member$ ?fail $?c))))
         ?obj <- (object (is-a CompensationPathVector)
           (id ?cpv)
           (Failures $?z))
         =>
         (modify ?fct (arguments ?cpv => $?failures))
         (modify-instance ?obj (Failures $?z ?fail)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::RetractEmptyReopenFact
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ? =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::AssertReopenBlocksOnWavefront
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen-blocks)
                          (arguments ?cpv))
         ?obj <- (object (is-a CompensationPathVector)
                         (id ?cpv)
                         (Failures $?failures))
         =>
         (modify-instance ?obj (Failures))
         (modify ?fct (action reopen)
                 (arguments ?cpv => $?failures)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen::ReopenBlockOnWavefront
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ?cpv => ?fail $?failures))
         ?wave <- (object (is-a Wavefront)
                          (Closed $?a ?fail $?b)
                          (contents $?cnts))
         ?bb <- (object (is-a BasicBlock)
                        (id ?fail)
                        (IsOpen FALSE))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?fail)
                        (InstructionList $?il)
                        (ImpossibleCompensationPathVectors $?icpv))
         =>
         (modify-instance ?bb (IsOpen TRUE))
         (bind ?qs (create$))
         (progn$ (?q ?icpv)
                 (bind ?qObj (instance-address (symbol-to-instance-name ?q)))
                 (bind ?qs (create$ ?qs (send ?qObj get-parent))))
         (modify-instance ?pa (ImpossibleCompensationPathVectors)
                          (InstructionList $?il ?qs)
                          (TargetCompensationPathVectors $?icpv))
         (modify-instance ?wave (contents $?cnts ?fail)
                          (Closed ?a ?b))
         (modify ?fct (arguments ?cpv => $?failures)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::ReaddFailureToCPV
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ?cpv => ?fail $?failures))
         ?wave <- (object (is-a Wavefront)
           (Closed $?c&:(not (member$ ?fail $?c))))
         ?obj <- (object (is-a CompensationPathVector)
           (id ?cpv)
           (Failures $?z))
         =>
         (modify ?fct (arguments ?cpv => $?failures))
         (modify-instance ?obj (Failures $?z ?fail)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::RetractEmptyReopenFact
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ? =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------


Used the modify command instead of a retract-assert combo in MergeRules.clp

I realized that using the modify command allows me to retain the same memory
space while only changing the part that needs to be changed.

I also modified the settify rules to completely settify one of the target
multislots if a single duplicate is found. This should reduce the number of
expensive matches overall.

;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.
;------------------------------------------------------------------------------
; MergeRules.clp - Contains all of the merge rules used in the analysis stages
; Written by Joshua Scoggins (11/18/2012)
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0)
			(modify ?f1 (action instruction-consume-list)
					  (arguments ?id => ?a ?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0)
			(modify ?f1 (action instruction-produce-list)
					  (arguments ?id => ?a ?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0)
			(modify ?f1 (arguments ?id => $?a $?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0)
			(modify ?f1 (arguments ?id => $?a $?b)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-consumes)
								(arguments ?a => ?b))
			=>
			(modify ?f (action instruction-consume-list)
					  (arguments ?b => ?a)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-produces)
								(arguments ?a => ?b))
			=>
			(modify ?f (action instruction-produce-list)
					  (arguments ?b => ?a)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers-Producers-And-LocalDependencies
			"Performs the actions of InjectConsumers and
			InjectProducersAndLocalDependencies in a single rule fire."
			(declare (salience 1))
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?t0))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?t1))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?c)
								  (Producers $?p)
								  (LocalDependencies $?ld))
			=>
			(retract ?f0 ?f1)
			(bind ?cs $?c)
			(bind ?ps $?p)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?t0)
						 (if (not (member$ ?target ?cs)) then
							(bind ?cs (insert$ ?cs 1 ?target))))
			  (progn$ (?target ?t1)
						 (if (not (member$ ?target ?lds)) then
							(bind ?lds (insert$ ?lds 1 ?target)))
						 (if (not (member$ ?target ?ps)) then
							(bind ?ps (insert$ ?ps 1 ?target))))
			  (modify-instance ?inst (Consumers ?cs) (Producers ?ps)
									 (LocalDependencies ?lds))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers
			"Adds a given consumer to the target instruction"
			?fct <- (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?cs))
			=>
			(retract ?fct)
			(bind ?cons $?cs)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?cons)) then
							(bind ?cons (insert$ ?cons 1 ?target)))))
			  (modify-instance ?inst (Consumers ?cons)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectProducersAndLocalDependencies
			"Adds a given producer to the target instruction."
			?fct <- (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Producers $?ps)
								  (LocalDependencies $?ld))
			=>
			(retract ?fct)
			(bind ?prods $?ps)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?lds)) then
						   (bind ?lds (create$ ?lds ?target)))
						 (if (not (member$ ?target ?prods)) then
						  (bind ?prods (create$ ?prods ?target)))))
			  (modify-instance ?inst (Producers ?prods) (LocalDependencies ?lds)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionProducers
			?inst <- (object (is-a Instruction)
								  (Producers $?a ?b $?c ?b $?d))
			=>
			;if we find one duplicate instance then just convert the whole thing
			;into a list
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (Producers ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionConsumers
			?inst <- (object (is-a Instruction)
								  (Consumers $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (Consumers ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyLocalDependencies
			?inst <- (object (is-a Instruction)
								  (LocalDependencies $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (LocalDependencies ?mid)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyNonLocalDependencies
			?inst <- (object (is-a Instruction)
								  (NonLocalDependencies $?a ?b $?c ?b $?d))
			=>
			(bind ?mid (create$ ?b))
			(bind ?all (create$ ?a ?c ?d))
			(progn$ (?t ?all)
			        (if (not (member$ ?t ?mid)) then
						   (bind ?mid (insert$ ?mid (+ ?t-index 1) ?t))))
			(modify-instance ?inst (NonLocalDependencies ?mid)))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
; MergeRules.clp - Contains all of the merge rules used in the analysis stages
; Written by Joshua Scoggins (11/18/2012)
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consumes)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0 ?f1)
			(assert (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?id => ?a ?b))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?a => ?id))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produces)
								 (arguments ?b&~?a => ?id))
			=>
			(retract ?f0 ?f1)
			(assert (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?id => ?a ?b))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0 ?f1)
			(assert (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?id => $?a $?b))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Multi
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?a))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?b))
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0 ?f1)
			(assert (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?id => $?a $?b))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeConsumers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-consumes)
								(arguments ?a => ?b))
			=>
			(retract ?f)
			(assert (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?b => ?a))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-merge::MergeProducers-Only
			(declare (salience -2))
			?f <- (message (to dependency-analysis)
								(action instruction-produces)
								(arguments ?a => ?b))
			=>
			(retract ?f)
			(assert (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?b => ?a))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers-Producers-And-LocalDependencies
			"Performs the actions of InjectConsumers and
			InjectProducersAndLocalDependencies in a single rule fire."
			(declare (salience 1))
			?f0 <- (message (to dependency-analysis)
								 (action instruction-produce-list)
								 (arguments ?id => $?t0))
			?f1 <- (message (to dependency-analysis)
								 (action instruction-consume-list)
								 (arguments ?id => $?t1))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?c)
								  (Producers $?p)
								  (LocalDependencies $?ld))
			=>
			(retract ?f0 ?f1)
			(bind ?cs $?c)
			(bind ?ps $?p)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?t0)
						 (if (not (member$ ?target ?cs)) then
							(bind ?cs (insert$ ?cs 1 ?target))))
			  (progn$ (?target ?t1)
						 (if (not (member$ ?target ?lds)) then
							(bind ?lds (insert$ ?lds 1 ?target)))
						 (if (not (member$ ?target ?ps)) then
							(bind ?ps (insert$ ?ps 1 ?target))))
			  (modify-instance ?inst (Consumers ?cs) (Producers ?ps)
									 (LocalDependencies ?lds))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectConsumers
			"Adds a given consumer to the target instruction"
			?fct <- (message (to dependency-analysis)
								  (action instruction-consume-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Consumers $?cs))
			=>
			(retract ?fct)
			(bind ?cons $?cs)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?cons)) then
							(bind ?cons (insert$ ?cons 1 ?target))))
			  (modify-instance ?inst (Consumers ?cons))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-inject::InjectProducersAndLocalDependencies
			"Adds a given producer to the target instruction."
			?fct <- (message (to dependency-analysis)
								  (action instruction-produce-list)
								  (arguments ?id => $?targets))
			?inst <- (object (is-a Instruction)
								  (id ?id)
								  (Producers $?ps)
								  (LocalDependencies $?ld))
			=>
			(retract ?fct)
			(bind ?prods $?ps)
			(bind ?lds $?ld)
			(object-pattern-match-delay
			  (progn$ (?target ?targets)
						 (if (not (member$ ?target ?lds)) then
							(bind ?lds (insert$ ?lds 1 ?target)))
						 (if (not (member$ ?target ?prods)) then
							(bind ?prods (insert$ ?prods 1 ?target))))
			  (modify-instance ?inst (Producers ?prods) (LocalDependencies ?lds))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionProducers
			?inst <- (object (is-a Instruction)
								  (Producers $?a ?b $?c ?b $?d))
			=>
			(modify-instance ?inst (Producers $?a ?b $?c $?d)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyInstructionConsumers
			?inst <- (object (is-a Instruction)
								  (Consumers $?a ?b $?c ?b $?d))
			=>
			(modify-instance ?inst (Consumers $?a ?b $?c $?d)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyLocalDependencies
			?inst <- (object (is-a Instruction)
								  (LocalDependencies $?a ?b $?c ?b $?d))
			=>
			(modify-instance ?inst (LocalDependencies $?a ?b $?c $?d)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis-make-set::SetifyNonLocalDependencies
			?inst <- (object (is-a Instruction)
								  (NonLocalDependencies $?a ?b $?c ?b $?d))
			=>
			(modify-instance ?inst (NonLocalDependencies $?a ?b $?c $?d)))
;------------------------------------------------------------------------------


Move the samples away from the main code branch for refactoring.
KHK.

git-svn-id: 9643e93313b82f5e4da82d8413267a0daa4b5472@1232 2cd91b7d-3b21-0410-a5f4-f42db4f24360

(deftemplate agent-message
       (slot sender)
       (slot receivers)
       (multislot reply-to)
       (slot performative)
       (slot content)
       (slot language)
       (slot encoding)
       (slot ontology)
       (slot protocol)
       (slot conversation-id)
       (slot in-reply-to)
       (slot reply-with)
       (slot reply-by)
       (multislot user-properties)
)

(deftemplate agent-description
       (slot name)
)

(defrule incoming-message
       (agent-description
               (name ?receiver)
       )
       (agent-message
               (sender ?sender)
               (receivers ?receiver)
               (reply-to ?replyto)
               (performative ?performative)
               (content ?content)
               (language ?language)
               (encoding ?encoding)
               (ontology ?ontology)
               (protocol ?protocol)
               (conversation-id ?conversationid)
               (in-reply-to ?inreplyto)
               (reply-with ?replywith)
               (reply-by ?replyby)
               (user-properties ?userproperties)
       )
       =>
       (printout t ?receiver " received a message" crlf)
       (agent-send-message ?sender ?replyto ?performative ?content ?language ?encoding ?ontology ?protocol ?conversationid)
)
(assert (agent-description (name "you") ) )
(assert (agent-message (sender "me")(receivers "you")(reply-to "peter" "paul" "marry")(performative "yes")(content "hello")(langauge "en")(encoding "utf8")(ontology "none")(protocol "1")(conversationid "100") ) )

error: pathspec 'examples/agent/message.clp' did not match any file(s) known to git