Finished porting wavefront-scheduling-dependency-analysis

I have not optimized the rules in this module as heavily as I've done in others
due to the fact that I need to make sure that the code works first before
making changes.

;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 stage is the actual act of scheduling the blocks on the wavefront.
; The first step is to reacquire all dependencies of the given blocks by
; running the same rules as before. The only difference is that we have to do
; it specially for the blocks on the wavefront.
;
; I'm thinking of just copying the rules from the analysis pass to here. It
; would be a duplication but I frankly don't care anymore.
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::CreateDependencyAnalysisTargets
         (declare (salience 10))
         (object (is-a Wavefront)
                 (parent ?r)
                 (contents $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e))
         (object (is-a PathAggregate)
                 (parent ?e)
                 (OriginalStopIndex ?si))
         =>
         ;only look at instructions starting at the original stop index. This
         ;prevents unncessary recomputation
         (assert (Evaluate ?e for dependencies starting at ?si)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::IdentifyWAR
         "Identifies a WAR dependency between two instructions. It will not
         match if it turns out the values are constant integers or constant
         floating point values"
         (Evaluate ?p for dependencies starting at ?si)
         ;TODO: Rewrite this to be more efficient
         ?i0 <- (object (is-a Instruction)
                        (parent ?p)
                        (id ?t0)
                        (TimeIndex ?ti0)
                        (Operands $? ?c $?))
         (object (is-a TaggedObject&~ConstantInteger&~ConstantFloatingPoint)
                 (id ?c))
         ?i1 <- (object (is-a Instruction)
                        (parent ?p)
                        (id ?t1)
                        (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
                        (DestinationRegisters $? ?c $?))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?t1 => ?t0))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::IdentifyRAW
         "Identifies a RAW dependency between two instructions in the same
         block. It will not match if it turns out that the values are constant
         integers or constant floating point values."
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a Instruction)
                 (parent ?p)
                 (id ?t0)
                 (TimeIndex ?ti0)
                 (DestinationRegisters $? ?c $?))
         (object (is-a TaggedObject&~ConstantInteger&~ConstantFloatingPoint)
                 (id ?c))
         (object (is-a Instruction)
                 (parent ?p)
                 (id ?t1)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
                 (Operands $? ?c $?))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?t1 => ?t0))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::IdentifyWAW
         "Identifies a WAW dependency between two instructions in the same
         block. It will not match if it turns out that the values are constant
         integers or constant floating point values."
         (Evaluate ?p for dependencies starting at ?si)
         ?i0 <- (object (is-a Instruction)
                        (parent ?p)
                        (id ?t0)
                        (TimeIndex ?ti0)
                        (DestinationRegisters $? ?c $?))
         (object (is-a TaggedObject&~ConstantInteger&~ConstantFloatingPoint)
                 (id ?c))
         ?i1 <- (object (is-a Instruction)
                        (parent ?p)
                        (id ?t1)
                        (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
                        (DestinationRegisters $? ?c $?))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?t1 => ?t0))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
;these call instruction checks only work for new instructions or those that
; dont have a call dependency. As that was the only way they got into the
; block in the first place
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::MarkCallInstructionDependency-ModifiesMemory
         "Creates a series of dependencies for all instructions following a
         call instruction if it turns out that the call could modify memory."
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a CallInstruction)
                 (id ?name)
                 (parent ?p)
                 (DoesNotAccessMemory FALSE) (OnlyReadsMemory FALSE)
                 (MayWriteToMemory TRUE)
                 (TimeIndex ?t0))
         (object (is-a Instruction)
                 (parent ?p)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?t0 ?ti1)))
                 (HasCallDependency FALSE) (id ?following))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?following => ?name))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?name => ?following))
                 (message (to wavefront-scheduling)
                          (action instruction-has-a-call-dependency)
                          (arguments ?following))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::MarkCallInstructionDependency-InlineAsm
         "Creates a series of dependencies for all instructions following a
         call instruction if it turns out that the call is inline asm."
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a CallInstruction)
                 (id ?name)
                 (parent ?p)
                 (IsInlineAsm TRUE)
                 (TimeIndex ?t0))
         (object (is-a Instruction)
                 (parent ?p)
                 (id ?following)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?t0 ?ti1)))
                 (HasCallDependency FALSE))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?following => ?name))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?name => ?following))
                 (message (to wavefront-scheduling)
                          (action instruction-has-a-call-dependency)
                          (arguments ?following))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::MarkCallInstructionDependency-SideEffects
         "Creates a series of dependencies for all instructions following a
         call instruction if it turns out that the call is inline asm."
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a CallInstruction)
                 (id ?name)
                 (parent ?p)
                 (MayHaveSideEffects TRUE)
                 (MayWriteToMemory TRUE)
                 (TimeIndex ?t0))
         (object (is-a Instruction)
                 (parent ?p)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?t0 ?ti1)))
                 (HasCallDependency FALSE)
                 (id ?following))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?following => ?name))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?name => ?following))
                 (message (to wavefront-scheduling)
                          (action instruction-has-a-call-dependency)
                          (arguments ?following))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::MarkNonLocalDependencies
         (Evaluate ?p for dependencies starting at ?si)
         ?inst <- (object (is-a Instruction)
                          (parent ?p)
                          (TimeIndex ?t&:(>= ?t ?si))
                          (NonLocalDependencies $?nld)
                          (Operands $? ?o $?))
         (object (is-a Instruction)
                 (id ?o)
                 (parent ~?p))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?o)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::Wavefront-MarkHasCallDependency
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action instruction-has-a-call-dependency)
                          (arguments ?f))

         ?obj <- (object (is-a Instruction)
                         (id ?f))
         =>
         (modify-instance ?obj (HasCallDependency TRUE))
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::InjectConsumers
         "Adds a given consumer to the target instruction"
         (declare (salience -5))
         ?fct <- (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?target => ?id))
         ?inst <- (object (is-a Instruction)
                          (id ?id)
                          (Consumers $?consumers))
         =>
         (retract ?fct)
         (if (not (member$ ?target $?consumers)) then
           (modify-instance ?inst (Consumers $?consumers ?target))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::InjectProducers
         "Adds a given producer to the target instruction"
         (declare (salience -5))
         ?fct <- (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?target => ?id))
         ?inst <- (object (is-a Instruction)
                          (id ?id)
                          (LocalDependencies $?ld)
                          (Producers $?prod))
         =>
         (retract ?fct)
         (modify-instance ?inst
                          (LocalDependencies $?ld
                                             (if (not (member$ ?target $?ld))
                                               then ?target))
                          (Producers $?prod
                                     (if (not (member$ ?target $?prod))
                                       then ?target))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::StoreToLoadDependency
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a StoreInstruction)
                 (parent ?p)
                 (id ?t0)
                 (TimeIndex ?ti0)
                 (MemoryTarget ?sym0))
         (object (is-a LoadInstruction)
                 (parent ?p)
                 (id ?t1)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
                 (MemoryTarget ?sym1))
         (test (or (eq ?sym0 ?sym1)
                   (eq ?sym0 UNKNOWN)))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?t1 => ?t0))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::StoreToStoreDependency
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a StoreInstruction)
                 (parent ?p)
                 (id ?t0)
                 (TimeIndex ?ti0)
                 (MemoryTarget ?sym0))
         (object (is-a StoreInstruction)
                 (parent ?p)
                 (id ?t1)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
                 (MemoryTarget ?sym1))
         (test (or (eq ?sym0 ?sym1)
                   (eq ?sym0 UNKNOWN)))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?t1 => ?t0))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::LoadToStoreDependency
         (Evaluate ?p for dependencies starting at ?si)
         (object (is-a LoadInstruction)
                 (parent ?p)
                 (id ?t0)
                 (TimeIndex ?ti0)
                 (MemoryTarget ?sym0))
         (object (is-a StoreInstruction)
                 (parent ?p)
                 (id ?t1)
                 (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
                 (MemoryTarget ?sym1))
         (test (or (eq ?sym0 ?sym1)
                   (eq ?sym0 UNKNOWN)))
         =>
         (assert (message (to wavefront-scheduling)
                          (action instruction-consumes)
                          (arguments ?t1 => ?t0))
                 (message (to wavefront-scheduling)
                          (action instruction-produces)
                          (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-dependency-analysis::FinishedDependencyAnalysis
         (declare (salience -800))
         ?fct <- (Evaluate ?p for dependencies starting at ?v)
         (object (is-a BasicBlock)
                 (id ?p)
                 (parent ?r))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule RemoveInstructionsFromProducers
         (declare (salience 768))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Remove evidence of ?tInst from instructions ?inst $?insts)
         ?iObj <- (object (is-a Instruction)
                          (ID ?inst)
                          (Producers $?pb ?tInst $?pa)
                          (LocalDependencies $?ldb ?tInst $?lda))
         =>
         (retract ?fct)
         (assert (Remove evidence of ?tInst from instructions $?insts))
         (modify-instance ?iObj (Producers $?pb $?pa)
                          (LocalDependencies $?ldb $?lda))
         (slot-insert$ ?iObj NonLocalDependencies 1 ?tInst))
;------------------------------------------------------------------------------
(defrule RetractRemoveInstructionsFromProducers
         (declare (salience 768))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Remove evidence of ? from instructions)
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule StartRecomputeBlock
         (declare (salience 100))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Recompute block ?b)
         ?bb <- (object (is-a BasicBlock) (ID ?b)
                        (Contents $?instructions ?last))
         (object (is-a TerminatorInstruction) (ID ?last))
         =>
         (modify-instance ?bb (ReadsFrom) (WritesTo) (HasMemoryBarrier FALSE))
         (retract ?fct)
         (assert (Recompute block ?b with instructions $?instructions)))
;------------------------------------------------------------------------------
(defrule RecomputeNonMemoryInstructionForBlock
         (declare (salience 99))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Recompute block ?b with instructions ?inst $?rest)
         (object (is-a BasicBlock) (ID ?b))
         (object (is-a Instruction&~LoadInstruction&~StoreInstruction)
                 (ID ?inst) (Parent ?b))
         =>
         (retract ?fct)
         (assert (Recompute block ?b with instructions $?rest)))
;------------------------------------------------------------------------------
(defrule RecomputeLoadInstructionForBlock
         (declare (salience 99))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Recompute block ?b with instructions ?inst $?rest)
         (object (is-a LoadInstruction) (ID ?inst) (Parent ?b)
                 (MemoryTarget ?mt))
         ?bb <- (object (is-a BasicBlock) (ID ?b))
         =>
         (if (not (member$ ?mt (send ?bb get-ReadsFrom))) then
           (slot-insert$ ?bb ReadsFrom 1 ?mt))
         (retract ?fct)
         (assert (Recompute block ?b with instructions $?rest)))
;------------------------------------------------------------------------------
(defrule RecomputeStoreInstructionForBlock
         (declare (salience 99))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Recompute block ?b with instructions ?inst $?rest)
         (object (is-a StoreInstruction) (ID ?inst) (Parent ?b)
                 (MemoryTarget ?mt))
         ?bb <- (object (is-a BasicBlock) (ID ?b))
         =>
         (if (not (member$ ?mt (send ?bb get-WritesTo))) then
           (slot-insert$ ?bb WritesTo 1 ?mt))
         (retract ?fct)
         (assert (Recompute block ?b with instructions $?rest)))
;------------------------------------------------------------------------------
(defrule FinishRecomputationForBlock
         (declare (salience 98))
         (Stage WavefrontSchedule $?)
         (Substage MergeUpdate $?)
         ?fct <- (Recompute block ?b with instructions)
         ?bb <- (object (is-a BasicBlock) (ID ?b) (ReadsFrom $?rf)
                        (WritesTo $?wt))
         =>
         (retract ?fct)
         (if (or (member$ UNKNOWN ?rf)
                 (member$ UNKNOWN ?wt)) then
           (modify-instance ?bb (HasMemoryBarrier TRUE))))
;------------------------------------------------------------------------------

;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 stage is the actual act of scheduling the blocks on the wavefront.
; The first step is to reacquire all dependencies of the given blocks by
; running the same rules as before. The only difference is that we have to do
; it specially for the blocks on the wavefront.
;
; I'm thinking of just copying the rules from the analysis pass to here. It
; would be a duplication but I frankly don't care anymore.
;------------------------------------------------------------------------------
(defrule CreateDependencyAnalysisTargets
			(declare (salience 10))
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(object (is-a Wavefront) (Parent ?r) (Contents $? ?e $?))
			(object (is-a BasicBlock) (ID ?e))
			(object (is-a PathAggregate) (Parent ?e) (OriginalStopIndex ?si))
			=>
			;only look at instructions starting at the original stop index. This
			;prevents unncessary recomputation
			(assert (Evaluate ?e for dependencies starting at ?si)))
;------------------------------------------------------------------------------
(defrule IdentifyWAR-Wavefront
			"Identifies a WAR dependency between two instructions. It will not
			match if it turns out the values are constant integers or constant
			floating point values"
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			?i0 <- (object (is-a Instruction) (Parent ?p) (ID ?t0)
								(Operands $? ?c $?) (TimeIndex ?ti0))
			(object (is-a TaggedObject&~ConstantInteger&~ConstantFloatingPoint)
					  (ID ?c))
			?i1 <- (object (is-a Instruction) (Parent ?p) (ID ?t1)
								(TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
								(DestinationRegisters $? ?c $?))
			=>
			(assert (Instruction ?t1 consumes ?t0)
					  (Instruction ?t0 produces ?t1)))
;------------------------------------------------------------------------------
(defrule IdentifyRAW-Wavefront
			"Identifies a RAW dependency between two instructions in the same
			block. It will not match if it turns out that the values are constant
			integers or constant floating point values."
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a Instruction) (Parent ?p) (ID ?t0)
					  (DestinationRegisters $? ?c $?) (TimeIndex ?ti0))
			(object (is-a TaggedObject&~ConstantInteger&~ConstantFloatingPoint)
					  (ID ?c))
			(object (is-a Instruction) (Parent ?p) (ID ?t1)
					  (Operands $? ?c $?)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1))))
			=>
			(assert (Instruction ?t1 consumes ?t0)
					  (Instruction ?t0 produces ?t1)))
;------------------------------------------------------------------------------
(defrule IdentifyWAW-Wavefront
			"Identifies a WAW dependency between two instructions in the same
			block. It will not match if it turns out that the values are constant
			integers or constant floating point values."
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			?i0 <- (object (is-a Instruction) (Parent ?p) (ID ?t0)
								(DestinationRegisters $? ?c $?) (TimeIndex ?ti0))
			(object (is-a TaggedObject&~ConstantInteger&~ConstantFloatingPoint)
					  (ID ?c))
			?i1 <- (object (is-a Instruction) (Parent ?p) (ID ?t1)
								(TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
								(DestinationRegisters $? ?c $?))
			=>
			(assert (Instruction ?t1 consumes ?t0)
					  (Instruction ?t0 produces ?t1)))
;------------------------------------------------------------------------------
;these call instruction checks only work for new instructions or those that
; dont have a call dependency. As that was the only way they got into the
; block in the first place
;------------------------------------------------------------------------------
(defrule MarkCallInstructionDependency-ModifiesMemory-Wavefront
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call could modify memory."
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a CallInstruction) (ID ?name) (Parent ?p)
					  (DoesNotAccessMemory FALSE) (OnlyReadsMemory FALSE)
					  (MayWriteToMemory TRUE)
					  (TimeIndex ?t0))
			(object (is-a Instruction) (Parent ?p)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?t0 ?ti1)))
					  (HasCallDependency FALSE) (ID ?following))
			=>
			(assert (Instruction ?following has a CallDependency)
					  (Instruction ?following consumes ?name)
					  (Instruction ?name produces ?following)))
;------------------------------------------------------------------------------
(defrule MarkCallInstructionDependency-InlineAsm-Wavefront
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call is inline asm."
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a CallInstruction) (ID ?name) (Parent ?p)
					  (IsInlineAsm TRUE)
					  (TimeIndex ?t0))
			(object (is-a Instruction) (Parent ?p)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?t0 ?ti1)))
					  (HasCallDependency FALSE) (ID ?following))
			=>
			(assert (Instruction ?following has a CallDependency)
					  (Instruction ?following consumes ?name)
					  (Instruction ?name produces ?following)))
;------------------------------------------------------------------------------
(defrule MarkCallInstructionDependency-SideEffects-Wavefront
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call is inline asm."
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a CallInstruction) (ID ?name) (Parent ?p)
					  (MayHaveSideEffects TRUE) (MayWriteToMemory TRUE)
					  (TimeIndex ?t0))
			(object (is-a Instruction) (Parent ?p)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?t0 ?ti1)))
					  (HasCallDependency FALSE) (ID ?following))
			=>
			(assert (Instruction ?following has a CallDependency)
					  (Instruction ?following consumes ?name)
					  (Instruction ?name produces ?following)))
;------------------------------------------------------------------------------
(defrule MarkNonLocalDependencies-Wavefront
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			?inst <- (object (is-a Instruction) (Parent ?p)
								  (TimeIndex ?t&:(>= ?t ?si))
								  (Operands $? ?o $?))
			(object (is-a Instruction) (ID ?o) (Parent ~?p))
			=>
			(slot-insert$ ?inst NonLocalDependencies 1 ?o))
;------------------------------------------------------------------------------
(defrule Wavefront-MarkHasCallDependency
			(declare (salience -2))
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			?fct <- (Instruction ?f has a CallDependency)
			?obj <- (object (is-a Instruction) (ID ?f))
			=>
			(modify-instance ?obj (HasCallDependency TRUE))
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule InjectConsumers-Wavefront
			"Adds a given consumer to the target instruction"
			(declare (salience -5))
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			?fct <- (Instruction ?target consumes ?id)
			?inst <- (object (is-a Instruction) (ID ?id))
			=>
			(retract ?fct)
			(if (not (member$ ?target (send ?inst get-Consumers))) then
			  (slot-insert$ ?inst Consumers 1 ?target)))
;------------------------------------------------------------------------------
(defrule InjectProducers-Wavefront
			"Adds a given producer to the target instruction"
			(declare (salience -5))
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			?fct <- (Instruction ?target produces ?id)
			?inst <- (object (is-a Instruction) (ID ?id))
			=>
			(retract ?fct)
			(if (not (member$ ?target (send ?inst get-LocalDependencies))) then
			  (slot-insert$ ?inst LocalDependencies 1 ?target))
			(if (not (member$ ?target (send ?inst get-Producers))) then
			  (slot-insert$ ?inst Producers 1 ?target)))
;------------------------------------------------------------------------------
(defrule StoreToLoadDependency-Wavefront
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a StoreInstruction) (Parent ?p) (ID ?t0)
					  (TimeIndex ?ti0) (MemoryTarget ?sym0))
			(object (is-a LoadInstruction) (Parent ?p) (ID ?t1)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
					  (MemoryTarget ?sym1))
			(test (or (eq ?sym0 ?sym1) (eq ?sym0 UNKNOWN)))
			=>
			(assert (Instruction ?t1 consumes ?t0)
					  (Instruction ?t0 produces ?t1)))
;------------------------------------------------------------------------------
(defrule StoreToStoreDependency-Wavefront
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a StoreInstruction) (Parent ?p) (ID ?t0)
					  (TimeIndex ?ti0) (MemoryTarget ?sym0))
			(object (is-a StoreInstruction) (Parent ?p) (ID ?t1)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
					  (MemoryTarget ?sym1))
			(test (or (eq ?sym0 ?sym1) (eq ?sym0 UNKNOWN)))
			=>
			(assert (Instruction ?t1 consumes ?t0)
					  (Instruction ?t0 produces ?t1)))
;------------------------------------------------------------------------------
(defrule LoadToStoreDependency-Wavefront
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			(Evaluate ?p for dependencies starting at ?si)
			(object (is-a LoadInstruction) (Parent ?p) (ID ?t0)
					  (TimeIndex ?ti0) (MemoryTarget ?sym0))
			(object (is-a StoreInstruction) (Parent ?p) (ID ?t1)
					  (TimeIndex ?ti1&:(and (>= ?ti1 ?si) (< ?ti0 ?ti1)))
					  (MemoryTarget ?sym1))
			(test (or (eq ?sym0 ?sym1) (eq ?sym0 UNKNOWN)))
			=>
			(assert (Instruction ?t1 consumes ?t0)
					  (Instruction ?t0 produces ?t1)))
;------------------------------------------------------------------------------
(defrule FinishedDependencyAnalysis
			(declare (salience -800))
			(Stage WavefrontSchedule $?)
			(Substage DependencyAnalysis $?)
			?fct <- (Evaluate ?p for dependencies starting at ?v)
			(object (is-a BasicBlock) (ID ?p) (Parent ?r))
			=>
			(assert (Schedule ?p for ?r))
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule RemoveInstructionsFromProducers
			(declare (salience 768))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Remove evidence of ?tInst from instructions ?inst $?insts)
			?iObj <- (object (is-a Instruction)
								  (ID ?inst)
								  (Producers $?pb ?tInst $?pa)
								  (LocalDependencies $?ldb ?tInst $?lda))
			=>
			(retract ?fct)
			(assert (Remove evidence of ?tInst from instructions $?insts))
			(modify-instance ?iObj (Producers $?pb $?pa)
								  (LocalDependencies $?ldb $?lda))
			(slot-insert$ ?iObj NonLocalDependencies 1 ?tInst))
;------------------------------------------------------------------------------
(defrule RetractRemoveInstructionsFromProducers
			(declare (salience 768))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Remove evidence of ? from instructions)
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule StartRecomputeBlock
			(declare (salience 100))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Recompute block ?b)
			?bb <- (object (is-a BasicBlock) (ID ?b)
								(Contents $?instructions ?last))
			(object (is-a TerminatorInstruction) (ID ?last))
			=>
			(modify-instance ?bb (ReadsFrom) (WritesTo) (HasMemoryBarrier FALSE))
			(retract ?fct)
			(assert (Recompute block ?b with instructions $?instructions)))
;------------------------------------------------------------------------------
(defrule RecomputeNonMemoryInstructionForBlock
			(declare (salience 99))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Recompute block ?b with instructions ?inst $?rest)
			(object (is-a BasicBlock) (ID ?b))
			(object (is-a Instruction&~LoadInstruction&~StoreInstruction)
					  (ID ?inst) (Parent ?b))
			=>
			(retract ?fct)
			(assert (Recompute block ?b with instructions $?rest)))
;------------------------------------------------------------------------------
(defrule RecomputeLoadInstructionForBlock
			(declare (salience 99))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Recompute block ?b with instructions ?inst $?rest)
			(object (is-a LoadInstruction) (ID ?inst) (Parent ?b)
					  (MemoryTarget ?mt))
			?bb <- (object (is-a BasicBlock) (ID ?b))
			=>
			(if (not (member$ ?mt (send ?bb get-ReadsFrom))) then
			  (slot-insert$ ?bb ReadsFrom 1 ?mt))
			(retract ?fct)
			(assert (Recompute block ?b with instructions $?rest)))
;------------------------------------------------------------------------------
(defrule RecomputeStoreInstructionForBlock
			(declare (salience 99))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Recompute block ?b with instructions ?inst $?rest)
			(object (is-a StoreInstruction) (ID ?inst) (Parent ?b)
					  (MemoryTarget ?mt))
			?bb <- (object (is-a BasicBlock) (ID ?b))
			=>
			(if (not (member$ ?mt (send ?bb get-WritesTo))) then
			  (slot-insert$ ?bb WritesTo 1 ?mt))
			(retract ?fct)
			(assert (Recompute block ?b with instructions $?rest)))
;------------------------------------------------------------------------------
(defrule FinishRecomputationForBlock
			(declare (salience 98))
			(Stage WavefrontSchedule $?)
			(Substage MergeUpdate $?)
			?fct <- (Recompute block ?b with instructions)
			?bb <- (object (is-a BasicBlock) (ID ?b) (ReadsFrom $?rf)
								(WritesTo $?wt))
			=>
			(retract ?fct)
			(if (or (member$ UNKNOWN ?rf)
					  (member$ UNKNOWN ?wt)) then
			  (modify-instance ?bb (HasMemoryBarrier TRUE))))
;------------------------------------------------------------------------------


A minor change.

A minor change.

; Remind that the ACLMessage has been defined with the following template:
; (deftemplate ACLMessage
;              (slot communicative-act) (slot sender) (multislot receiver)
;              (slot reply-with) (slot in-reply-to) (slot envelope)
;              (slot conversation-id) (slot protocol)
;              (slot language) (slot ontology) (slot content) )
; refer to Fipa97 Part 2 (www.cselt.it/fipa) for the description of the
; ACLMessage parameters.
;
; Remind that Jade has also asserted for you the fact
; (MyAgent (name <agentname)) that is usefull to know the name of your agent
;
; Finally, remind that Jade has built a userfunction called send
; to send messages to other agents. There are two styles to call send:
; ?m <- (assert (ACLMessage (communicative-act inform) (receiver agent)))
; (send ?m)
; or, in alternative
; (send (assert (ACLMessage (communicative-act inform) (receiver agent))))
; The two following rules show the usage of both styles. One of the two
; rules can be used

(defrule proposal
 "When a 'cfp' message arrives from an agent ?s, this rule asserts a
  'propose' message to the same sender and retract the just arrived message"
 ?m <- (ACLMessage (communicative-act cfp) (sender ?s) (content ?c) (receiver ?r))
 =>
 (send (assert (ACLMessage (communicative-act propose) (receiver ?s) (content ?c))))
; (assert (ACLMessage (communicative-act propose) (sender ?r) (receiver ?s) (content ?c)))
 (retract ?m)
)

(defrule send-a-message
 "When a message is asserted whose sender is this agent, the message is
  sent and then retracted from the knowledge base."
 (MyAgent (name ?n))
 ?m <- (ACLMessage (sender ?n))
 =>
 (send ?m)
 (retract ?m)
)

(watch facts)
(reset)

(run)
; if you put run here, Jess is run before waiting for a message arrival,
; if you do not put (run here, the agent waits before for the arrival of the
; first message and then runs Jess.

; Remind that the ACLMessage has been defined with the following template:
; (deftemplate ACLMessage
;              (slot communicative-act) (slot sender) (multislot receiver)
;              (slot reply-with) (slot in-reply-to) (slot envelope)
;              (slot conversation-id) (slot protocol)
;              (slot language) (slot ontology) (slot content) )
; refer to Fipa97 Part 2 (www.cselt.it/fipa) for the description of the
; ACLMessage parameters.
;
; Remind that Jade has also asserted for you the fact
; (MyAgent (name <agentname)) that is usefull to know the name of your agent
;
; Finally, remind that Jade has built a userfunction called send
; to send messages to other agents. There are two styles to call send:
; ?m <- (assert (ACLMessage (communicative-act inform) (receiver agent)))
; (send ?m)
; or, in alternative
; (send (assert (ACLMessage (communicative-act inform) (receiver agent))))
; The two following rules show the usage of both styles. One of the two
; rules can be used

(defrule proposal
 "When a 'cfp' message arrives from an agent ?s, this rule asserts a
  'propose' message to the same sender and retract the just arrived message"
 ?m <- (ACLMessage (communicative-act cfp) (sender ?s) (content ?c) (receiver ?r))
 =>
;(send (assert (ACLMessage (communicative-act propose) (receiver ?s) (content ?c))))
 (assert (ACLMessage (communicative-act propose) (sender ?r) (receiver ?s) (content ?c)))
 (retract ?m)
)

(defrule send-a-message
 "When a message is asserted whose sender is this agent, the message is
  sent and then retracted from the knowledge base."
 (MyAgent (name ?n))
 ?m <- (ACLMessage (sender ?n))
 =>
 (send ?m)
 (retract ?m)
)

(watch facts)
(reset)

(run)
; if you put run here, Jess is run before waiting for a message arrival,
; if you do not put (run here, the agent waits before for the arrival of the
; first message and then runs Jess.


Modified instance-address in ReindexBasicBlock to search all modules

;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-identify::PropagateAggregateInformation
         "Pulls instruction propagation information from all elements on paths
         that immediately precede this element on the wavefront and merges it
         into the path aggregate itself"
         (message (to wavefront-scheduling)
                  (action propagate-aggregates)
                  (arguments ?e))
         ;if this element is on the wavefront then we can be certain that all
         ;of it's predecessors are above it. That is the definition of being on
         ;the wavefront
         ?pa <- (object (is-a PathAggregate)
                        (parent ?e))
         (object (is-a Diplomat)
                 (id ?e)
                 (PreviousPathElements $? ?z $?))
         (object (is-a PathAggregate)
                 (parent ?z)
                 (InstructionPropagation $? ?targ ?alias ? ! $?))
         =>
         ;replace parent blocks of previous path elements with the name of the
         ;element this was acquired from
         ;(printout t "Put (" ?targ " " ?alias " " ?z "! ) into " ?pp crlf)
         (slot-insert$ ?pa InstructionPropagation 1 ?targ ?alias ?z !))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-identify::RetractAggregationInformation
         (declare (salience -50))
         ?fct <- (message (to wavefront-scheduling)
                          (action propagate-aggregates)
                          (arguments ?))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-identify::AssertPhiNodePropagationPredicateIsBlock
         (declare (salience 1))
         (object (is-a Wavefront)
                 (parent ?r)
                 (values $? ?e $?))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?e)
                        (InstructionPropagation ?targ ?alias ?pred ! $?rest))
         =>
         (modify-instance ?pa (InstructionPropagation $?rest))
         (assert (message (to wavefront-scheduling)
                          (action propagation-target)
                          (arguments target ?targ
                                     alias ?alias
                                     from ?pred
                                     for ?e))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::RemoveDuplicateElements
         "Removes propagation targets that represent the same value but come from
         different previous blocks/regions. When this is seen it's not necessary to
         create a phi node. This is evident because the aliases are the same across
         multiple paths of execution."
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a
                                    from ?p0
                                    for ?b))
         ?f1 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a
                                    from ?p1&~?p0
                                    for ?b))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?b)
                        (InstructionPropagation $?ip))
         =>
         (retract ?f0 ?f1)
         (modify-instance ?pa (InstructionPropagation $?ip ?t ?a ?b !)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::MergePhiNodePropagationWithOtherPropagation
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a0
                                    from ?p0
                                    for ?b))
         ?f1 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a1&~?a0
                                    from ?p1&~?p0
                                    for ?b))
         =>
         (retract ?f0 ?f1)
         (assert (message (to wavefront-scheduling)
                          (action create-phi-node)
                          (arguments target-instruction ?t
                                     block ?b => ?a0 ?p0 ?a1 ?p1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::MergePhiNodePropagationWithCreateStatement
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a0
                                    from ?p0
                                    for ?b))
         ?f1 <- (message (to wavefront-scheduling)
                         (action create-phi-node)
                         (arguments target-instruction ?t
                                    block ?b => $?targets))
         =>
         (retract ?f0)
         (modify ?f1 (arguments target-instruction ?t
                                block ?b => $?targets ?a0 ?p0)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::PutUnfulfilledItemsBackIntoPropagationList
         (declare (salience -10))
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a0
                                    from ?p0
                                    for ?b))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?b)
                        (InstructionPropagation $?ip))
         =>
         (retract ?f0)
         (modify-instance ?pa (InstructionPropagation $?ip ?t ?a0 ?b !)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::NamePhiNodeFromCreateStatement-NotOriginalBlock
         (declare (salience -12))
         ?fct <- (message (to wavefront-scheduling)
                          (action create-phi-node)
                          (arguments target-instruction ?t
                                     block ?b => $?elements))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b)
                           (ScheduledInstructions $?si)
                           (InstructionPropagation $?ip)
                           (ReplacementActions $?ra))

         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (contents ?first $?rest)
                        (UnlinkedInstructions
                          $?ui&:(not (member$ ?t $?ui))))
         (object (is-a Instruction)
                 (id ?first)
                 (pointer ?bPtr))
         (object (is-a Instruction)
                 (id ?t)
                 (Type ?ty))
         (object (is-a LLVMType)
                 (id ?ty)
                 (pointer ?typePtr))
         =>
         (modify ?fct (action update-block-duration)
                 (arguments ?b))
         (bind ?name (sym-cat phi. (gensym*) . ?t))
         (bind ?count (/ (length$ $?elements) 2))
         ;make the phinode in LLVM and get it's address back
         (bind ?phiPtr
               (llvm-make-phi-node ?name
                                   ?typePtr
                                   ?count
                                   ?bPtr
                                   (symbol-to-pointer-list $?elements)))
         ;build a CLIPS representation of it
         (make-instance ?name of PhiNode
                        (parent ?b)
                        (TimeIndex 0)
                        (pointer ?phiPtr)
                        (IncomingValueCount ?count)
                        (Operands $?elements))
         ;we've scheduled the given original instruction into this block
         ; although it's just a ruse
         (modify-instance ?agObj (ScheduledInstructions $?si ?t)
                          (InstructionPropagation $?ip ?t ?name ?b !)
                          (ReplacementActions $?ra ?t ?name !))
         (modify-instance ?bb (contents ?name ?first $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::NamePhiNodeFromCreateStatement-OriginalBlock
         (declare (salience -12))
         ?fct <- (message (to wavefront-scheduling)
                          (action create-phi-node)
                          (arguments target-instruction ?t
                                     block ?b => $?elements))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b)
                           (ScheduledInstructions $?si))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (contents ?first $?rest)
                        (UnlinkedInstructions
                          $?ui&:(not (member$ ?t $?ui))))
         (object (is-a Instruction)
                 (id ?first)
                 (pointer ?bPtr))
         ?tObj <- (object (is-a Instruction)
                          (id ?t)
                          (Type ?ty)
                          (pointer ?tPtr))
         (object (is-a LLVMType)
                 (id ?ty)
                 (pointer ?dataType))
         =>
         (modify ?fct (action update-block-duration)
                 (arguments ?b))
         (bind ?name (sym-cat phi. (gensym*) . ?t))
         (bind ?count (/ (length$ $?elements) 2))
         (bind ?pointers (symbol-to-pointer-list ?elements))
         (bind ?phiPointer
               (llvm-make-phi-node ?name ?dataType ?count ?bPtr ?pointers))
         (bind ?phiObj (make-instance ?name of PhiNode
                                      (parent ?b)
                                      (TimeIndex 0)
                                      (pointer ?phiPointer)
                                      (IncomingValueCount ?count)
                                      (Operands $?elements)))
         (llvm-replace-all-uses ?tPtr ?phiPointer)
         (llvm-unlink-and-delete-instruction ?tPtr)
         (unmake-instance ?tObj)
         (modify-instance ?agObj (ScheduledInstructions $?si ?t))
         (modify-instance ?bb (contents ?name ?first $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node-update::ReindexBasicBlock
         ?fct <- (message (to wavefront-scheduling)
                          (action update-block-duration)
                          (arguments ?b))
         (object (is-a BasicBlock)
                 (id ?b)
                 (contents $?c))
         =>
         ;this is very much procedural but I frankly don't care
         ;anymore.
         (progn$ (?t ?c)
                 (bind ?obj (instance-address * (symbol-to-instance-name ?t)))
                 (modify-instance ?obj (TimeIndex (- ?t-index 1))))
         (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-identify::PropagateAggregateInformation
         "Pulls instruction propagation information from all elements on paths
         that immediately precede this element on the wavefront and merges it
         into the path aggregate itself"
         (message (to wavefront-scheduling)
                  (action propagate-aggregates)
                  (arguments ?e))
         ;if this element is on the wavefront then we can be certain that all
         ;of it's predecessors are above it. That is the definition of being on
         ;the wavefront
         ?pa <- (object (is-a PathAggregate)
                        (parent ?e))
         (object (is-a Diplomat)
                 (id ?e)
                 (PreviousPathElements $? ?z $?))
         (object (is-a PathAggregate)
                 (parent ?z)
                 (InstructionPropagation $? ?targ ?alias ? ! $?))
         =>
         ;replace parent blocks of previous path elements with the name of the
         ;element this was acquired from
         ;(printout t "Put (" ?targ " " ?alias " " ?z "! ) into " ?pp crlf)
         (slot-insert$ ?pa InstructionPropagation 1 ?targ ?alias ?z !))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-identify::RetractAggregationInformation
         (declare (salience -50))
         ?fct <- (message (to wavefront-scheduling)
                          (action propagate-aggregates)
                          (arguments ?))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-identify::AssertPhiNodePropagationPredicateIsBlock
         (declare (salience 1))
         (object (is-a Wavefront)
                 (parent ?r)
                 (values $? ?e $?))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?e)
                        (InstructionPropagation ?targ ?alias ?pred ! $?rest))
         =>
         (modify-instance ?pa (InstructionPropagation $?rest))
         (assert (message (to wavefront-scheduling)
                          (action propagation-target)
                          (arguments target ?targ
                                     alias ?alias
                                     from ?pred
                                     for ?e))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::RemoveDuplicateElements
         "Removes propagation targets that represent the same value but come from
         different previous blocks/regions. When this is seen it's not necessary to
         create a phi node. This is evident because the aliases are the same across
         multiple paths of execution."
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a
                                    from ?p0
                                    for ?b))
         ?f1 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a
                                    from ?p1&~?p0
                                    for ?b))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?b)
                        (InstructionPropagation $?ip))
         =>
         (retract ?f0 ?f1)
         (modify-instance ?pa (InstructionPropagation $?ip ?t ?a ?b !)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::MergePhiNodePropagationWithOtherPropagation
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a0
                                    from ?p0
                                    for ?b))
         ?f1 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a1&~?a0
                                    from ?p1&~?p0
                                    for ?b))
         =>
         (retract ?f0 ?f1)
         (assert (message (to wavefront-scheduling)
                          (action create-phi-node)
                          (arguments target-instruction ?t
                                     block ?b => ?a0 ?p0 ?a1 ?p1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::MergePhiNodePropagationWithCreateStatement
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a0
                                    from ?p0
                                    for ?b))
         ?f1 <- (message (to wavefront-scheduling)
                         (action create-phi-node)
                         (arguments target-instruction ?t
                                    block ?b => $?targets))
         =>
         (retract ?f0)
         (modify ?f1 (arguments target-instruction ?t
                                block ?b => $?targets ?a0 ?p0)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::PutUnfulfilledItemsBackIntoPropagationList
         (declare (salience -10))
         ?f0 <- (message (to wavefront-scheduling)
                         (action propagation-target)
                         (arguments target ?t
                                    alias ?a0
                                    from ?p0
                                    for ?b))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?b)
                        (InstructionPropagation $?ip))
         =>
         (retract ?f0)
         (modify-instance ?pa (InstructionPropagation $?ip ?t ?a0 ?b !)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::NamePhiNodeFromCreateStatement-NotOriginalBlock
         (declare (salience -12))
         ?fct <- (message (to wavefront-scheduling)
                          (action create-phi-node)
                          (arguments target-instruction ?t
                                     block ?b => $?elements))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b)
                           (ScheduledInstructions $?si)
                           (InstructionPropagation $?ip)
                           (ReplacementActions $?ra))

         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (contents ?first $?rest)
                        (UnlinkedInstructions
                          $?ui&:(not (member$ ?t $?ui))))
         (object (is-a Instruction)
                 (id ?first)
                 (pointer ?bPtr))
         (object (is-a Instruction)
                 (id ?t)
                 (Type ?ty))
         (object (is-a LLVMType)
                 (id ?ty)
                 (pointer ?typePtr))
         =>
         (modify ?fct (action update-block-duration)
                 (arguments ?b))
         (bind ?name (sym-cat phi. (gensym*) . ?t))
         (bind ?count (/ (length$ $?elements) 2))
         ;make the phinode in LLVM and get it's address back
         (bind ?phiPtr
               (llvm-make-phi-node ?name
                                   ?typePtr
                                   ?count
                                   ?bPtr
                                   (symbol-to-pointer-list $?elements)))
         ;build a CLIPS representation of it
         (make-instance ?name of PhiNode
                        (parent ?b)
                        (TimeIndex 0)
                        (pointer ?phiPtr)
                        (IncomingValueCount ?count)
                        (Operands $?elements))
         ;we've scheduled the given original instruction into this block
         ; although it's just a ruse
         (modify-instance ?agObj (ScheduledInstructions $?si ?t)
                          (InstructionPropagation $?ip ?t ?name ?b !)
                          (ReplacementActions $?ra ?t ?name !))
         (modify-instance ?bb (contents ?name ?first $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node::NamePhiNodeFromCreateStatement-OriginalBlock
         (declare (salience -12))
         ?fct <- (message (to wavefront-scheduling)
                          (action create-phi-node)
                          (arguments target-instruction ?t
                                     block ?b => $?elements))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b)
                           (ScheduledInstructions $?si))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (contents ?first $?rest)
                        (UnlinkedInstructions
                          $?ui&:(not (member$ ?t $?ui))))
         (object (is-a Instruction)
                 (id ?first)
                 (pointer ?bPtr))
         ?tObj <- (object (is-a Instruction)
                          (id ?t)
                          (Type ?ty)
                          (pointer ?tPtr))
         (object (is-a LLVMType)
                 (id ?ty)
                 (pointer ?dataType))
         =>
         (modify ?fct (action update-block-duration)
                 (arguments ?b))
         (bind ?name (sym-cat phi. (gensym*) . ?t))
         (bind ?count (/ (length$ $?elements) 2))
         (bind ?pointers (symbol-to-pointer-list ?elements))
         (bind ?phiPointer
               (llvm-make-phi-node ?name ?dataType ?count ?bPtr ?pointers))
         (bind ?phiObj (make-instance ?name of PhiNode
                                      (parent ?b)
                                      (TimeIndex 0)
                                      (pointer ?phiPointer)
                                      (IncomingValueCount ?count)
                                      (Operands $?elements)))
         (llvm-replace-all-uses ?tPtr ?phiPointer)
         (llvm-unlink-and-delete-instruction ?tPtr)
         (unmake-instance ?tObj)
         (modify-instance ?agObj (ScheduledInstructions $?si ?t))
         (modify-instance ?bb (contents ?name ?first $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-phi-node-update::ReindexBasicBlock
         ?fct <- (message (to wavefront-scheduling)
                          (action update-block-duration)
                          (arguments ?b))
         (object (is-a BasicBlock)
                 (id ?b)
                 (contents $?c))
         =>
         ;this is very much procedural but I frankly don't care
         ;anymore.
         (progn$ (?t ?c)
                 (bind ?obj (instance-address (symbol-to-instance-name ?t)))
                 (modify-instance ?obj (TimeIndex (- ?t-index 1))))
         (retract ?fct))
;------------------------------------------------------------------------------


Create task6.clp

Create task6.clp

(defrule node
  =>
  (printout t "n1=")
  (bind ?n1 (read))
  (printout t "n2=")
  (bind ?n2 (read))
  (while TRUE do
    (if (= ?n1 ?n2) then
      (printout t "nod is: " ?n1)
      (return)
    )

    (if (> ?n1 ?n2) then
      (bind ?n1 (- ?n1 ?n2))
    else
      (bind ?n2 (- ?n2 ?n1))
    )
  )
)

error: pathspec 'ssu-ai-level-2/chapter5/task6.clp' did not match any file(s) known to git


Reactivated unknown file retraction

Reactivated unknown file retraction

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; GLConstantConversion.clp - an expert system that reads a define and generates
; conversion code for it.
;------------------------------------------------------------------------------
(defclass opened-file
  (is-a USER)
  (slot id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate file-line
             (slot index)
             (slot parent)
             (slot type)
             (multifield contents))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule open-target-file
         "This rule takes a fact of the above INPUT FORM and attempts to open the file"
         ?fct <- (parse constant file ?path)
         =>
         (bind ?name (gensym*))
         (retract ?fct)
         (if (open ?path ?name "r") then
           (make-instance of opened-file (id ?name) (index 0))
           (assert (read file ?name))
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule build-file-line
         ?fct <- (read file ?fid)
         ?obj <- (object (is-a opened-file)
                         (id ?fid))
         =>
         (retract ?fct)
         (bind ?result (send ?obj read-line))
         (if (neq ?result EOF) then
           (assert (read file ?fid)
                   (file-line (index (send ?obj next-index))
                              (type UNKNOWN)
                              (parent ?fid)
                              (contents (explode$ ?result))))
           else
           (send ?obj close-file)
           (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule retract-unknowns
         (declare (salience -10))
         ?f <- (file-line (type UNKNOWN))
         =>
         (retract ?f))
;------------------------------------------------------------------------------
(defrule mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (file-line (type UNKNOWN)
                          (contents /* $? */))
         =>
         (modify ?f (type heading)))
;------------------------------------------------------------------------------
(defrule mark-entry-line
         "Tags lines that are defines and modifies the associated contents"
         ?f <- (file-line (type UNKNOWN)
                          (contents #define ?name ?))
         =>
         (modify ?f (type #define) (contents ?name)))
;------------------------------------------------------------------------------
(defrule merge-three-line-headers
         "Merges simple three line headings into one rule"
         ?f0 <- (file-line (index ?i)
                           (type UNKNOWN)
                           (contents /*))
         ?f1 <- (file-line (index ?i2&:(= ?i2 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents * $?c))
         ?f2 <- (file-line (index ?i3&:(= ?i3 (+ ?i 2)))
                           (type UNKNOWN)
                           (contents */))
         =>
         (retract ?f1 ?f2)
         (modify ?f0 (contents /* $?c */)))
;------------------------------------------------------------------------------
(defrule mark-glapi-calls
         "marks glapi calls"
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $? "(" $? ")"))
         =>
         (modify ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule merge-potential-glapi-calls
         "Merges the next line of a GLAPI call if the line doesn't end with )"
         (declare (salience -1))
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $?vals "(" $?c)
                          (index ?i))
         (test (not (member$ ")" $?c)))
         ?f0 <- (file-line (index ?i0&:(= ?i0 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents $?contents))
         =>
         (retract ?f)
         (modify ?f0 (contents GLAPI $?vals "(" $?c $?contents)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; GLConstantConversion.clp - an expert system that reads a define and generates
; conversion code for it.
;------------------------------------------------------------------------------
(defclass opened-file
  (is-a USER)
  (slot id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate file-line
             (slot index)
             (slot parent)
             (slot type)
             (multifield contents))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule open-target-file
         "This rule takes a fact of the above INPUT FORM and attempts to open the file"
         ?fct <- (parse constant file ?path)
         =>
         (bind ?name (gensym*))
         (retract ?fct)
         (if (open ?path ?name "r") then
           (make-instance of opened-file (id ?name) (index 0))
           (assert (read file ?name))
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule build-file-line
         ?fct <- (read file ?fid)
         ?obj <- (object (is-a opened-file)
                         (id ?fid))
         =>
         (retract ?fct)
         (bind ?result (send ?obj read-line))
         (if (neq ?result EOF) then
           (assert (read file ?fid)
                   (file-line (index (send ?obj next-index))
                              (type UNKNOWN)
                              (parent ?fid)
                              (contents (explode$ ?result))))
           else
           (send ?obj close-file)
           (unmake-instance ?obj)))
;------------------------------------------------------------------------------
;(defrule retract-unknowns
; (declare (salience -10))
; ?f <- (file-line (type UNKNOWN))
; =>
; (retract ?f))
;------------------------------------------------------------------------------
(defrule mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (file-line (type UNKNOWN)
                          (contents /* $? */))
         =>
         (modify ?f (type heading)))
;------------------------------------------------------------------------------
(defrule mark-entry-line
         "Tags lines that are defines and modifies the associated contents"
         ?f <- (file-line (type UNKNOWN)
                          (contents #define ?name ?))
         =>
         (modify ?f (type #define) (contents ?name)))
;------------------------------------------------------------------------------
(defrule merge-three-line-headers
         "Merges simple three line headings into one rule"
         ?f0 <- (file-line (index ?i)
                           (type UNKNOWN)
                           (contents /*))
         ?f1 <- (file-line (index ?i2&:(= ?i2 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents * $?c))
         ?f2 <- (file-line (index ?i3&:(= ?i3 (+ ?i 2)))
                           (type UNKNOWN)
                           (contents */))
         =>
         (retract ?f1 ?f2)
         (modify ?f0 (contents /* $?c */)))
;------------------------------------------------------------------------------
(defrule mark-glapi-calls
         "marks glapi calls"
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $? "(" $? ")"))
         =>
         (modify ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule merge-potential-glapi-calls
         "Merges the next line of a GLAPI call if the line doesn't end with )"
         (declare (salience -1))
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $?vals "(" $?c)
                          (index ?i))
         (test (not (member$ ")" $?c)))
         ?f0 <- (file-line (index ?i0&:(= ?i0 (+ ?i 1)))
                           (type UNKNOWN)
                           (contents $?contents))
         =>
         (retract ?f)
         (modify ?f0 (contents GLAPI $?vals "(" $?c $?contents)))
;------------------------------------------------------------------------------