Updated WavefrontInitialization.clp to use modules

The code has been rewritten to also use messages as well.

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; NOTE: This is the execution order of the wavefront scheduler
;(defrule InitializeWavefrontSchedulingFacts
;         (declare (salience 1001))
;         (Stage WavefrontSchedule $?)
;         =>
;         (assert (Substage Init
;                           Identify
;                           PhiIdentify
;                           PhiNode
;                           PhiNodeUpdate
;                           Pathing
;                           Strip
;                           Inject
;                           Acquire
;                           Slice
;                           AnalyzeInit
;                           GenerateAnalyze0
;                           GenerateAnalyze
;                           Analyze
;                           SliceAnalyze
;                           MergeInit
;                           Merge
;                           MergeUpdate
;                           ReopenBlocks
;                           Ponder
;                           Rename
;                           DependencyAnalysis
;                           AdvanceInit
;                           AdvanceIdentify
;                           Advance
;                           AdvanceEnd
;                           Update)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-init::build-path-aggregate-for-block
         (declare (salience 100))
         (object (is-a Wavefront)
                 (parent ?r)
                 (contents $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e)
                 (contents $?c))
         =>
         (assert (message (to wavefront-schedule)
                          (action propagate-aggregates)
                          (arguments ?e)))
         (make-instance of PathAggregate (parent ?e)
                        (OriginalStopIndex (- (length$ $?c) 1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-init::build-path-aggregate-for-region
         (declare (salience 100))
         (object (is-a Wavefront)
                 (parent ?r)
                 (contents $? ?e $?))
         (object (is-a Region)
                 (id ?e))
         =>
         (assert (message (to wavefront-schedule)
                          (action propagate-aggregates)
                          (arguments ?e)))
         (make-instance of PathAggregate (parent ?e)))
;------------------------------------------------------------------------------

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defrule InitializeWavefrontSchedulingFacts
			(declare (salience 1001))
			(Stage WavefrontSchedule $?)
			=>
			(assert (Substage Init
									Identify
									PhiIdentify
									PhiNode
									PhiNodeUpdate
									Pathing
									Strip
									Inject
									Acquire
									Slice
									AnalyzeInit
									GenerateAnalyze0
									GenerateAnalyze
									Analyze
									SliceAnalyze
									MergeInit
									Merge
									MergeUpdate
									ReopenBlocks
									Ponder
									Rename
									DependencyAnalysis
									;ScheduleObjectCreation
									;ScheduleObjectUsage
									;ResetScheduling
									;InitLLVMUpdate
									;LLVMUpdate
									AdvanceInit
									AdvanceIdentify
									Advance
									AdvanceEnd
									Update)))
;------------------------------------------------------------------------------
(defrule NextWavefrontSchedulingSubstage
			(declare (salience -1000))
			(Stage WavefrontSchedule $?)
			?fct <- (Substage ? $?rest)
			=>
			(retract ?fct)
			(assert (Substage $?rest)))
;------------------------------------------------------------------------------
(defrule RetractSubstageCompletely
			(declare (salience -1001))
			(Stage WavefrontSchedule $?)
			?fct <- (Substage)
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule InitializeWavefrontSchedulingForARegion-SelectBlockDirectly
			(declare (salience 2))
			(Stage WavefrontInit $?)
			(object (is-a Region) (CanWavefrontSchedule TRUE) (ID ?r)
					  (Entrances $? ?e $?))
			(object (is-a BasicBlock) (ID ?e) (Parent ?r))
			=>
			(assert (Add ?e to wavefront for ?r)))
;------------------------------------------------------------------------------
(defrule InitializeWavefrontSchedulingForARegion-AssertRegionInstead
			(declare (salience 2))
			(Stage WavefrontInit $?)
			(object (is-a Region) (CanWavefrontSchedule TRUE) (ID ?r)
					  (Entrances $? ?e $?))
			(object (is-a BasicBlock) (ID ?e) (Parent ~?r))
			(object (is-a Region) (Parent ?r) (Entrances $? ?e $?) (ID ?q))
			=>
			(assert (Add ?q to wavefront for ?r)))
;------------------------------------------------------------------------------
(defrule MergeWavefrontCreationContents-Convert-SingleSingle
			(declare (salience 1))
			(Stage WavefrontInit $?)
			?f0 <- (Add ?v0 to wavefront for ?r)
			?f1 <- (Add ?v1 to wavefront for ?r)
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0 ?f1)
			(assert (Create wavefront for ?r containing ?v0 ?v1)))
;------------------------------------------------------------------------------
(defrule MergeWavefrontCreationContents-Convert-MultiSingle
			(declare (salience 1))
			(Stage WavefrontInit $?)
			?f0 <- (Add ?v0 to wavefront for ?r)
			?f1 <- (Create wavefront for ?r containing $?g0)

			=>
			(retract ?f0 ?f1)
			(assert (Create wavefront for ?r containing $?g0 ?v0)))
;------------------------------------------------------------------------------
(defrule MergeWavefrontCreationContents-Convert-MultiMulti
			(declare (salience 1))
			(Stage WavefrontInit $?)
			?f0 <- (Create wavefront for ?r containing $?g0)
			?f1 <- (Create wavefront for ?r containing $?g1)
			(test (neq ?f0 ?f1))
			=>
			(retract ?f0 ?f1)
			(assert (Create wavefront for ?r containing $?g0 $?g1)))
;------------------------------------------------------------------------------
(defrule ConvertWavefrontCreationFact
			(declare (salience 1))
			(Stage WavefrontInit $?)
			?f0 <- (Add ?v0 to wavefront for ?r)
			=>
			(retract ?f0)
			(assert (Create wavefront for ?r containing ?v0)))
;------------------------------------------------------------------------------
(defrule ConstructInitialWavefront
			(Stage WavefrontInit $?)
			?f0 <- (Create wavefront for ?r containing $?w)
			=>
			(retract ?f0)
			(make-instance of Wavefront (Parent ?r) (Contents ?w)))
;------------------------------------------------------------------------------
(defrule ConstructPathAggregateForBlock
			(declare (salience 100))
			(Stage WavefrontSchedule $?)
			(Substage Init $?)
			(object (is-a Hint) (Type Wavefront) (Parent ?r) (Contents $? ?e $?))
			?bb <- (object (is-a BasicBlock) (ID ?e) (Contents $?c))
			=>
			(assert (Propagate aggregates of ?e))
			(make-instance of PathAggregate (Parent ?e) (OriginalStopIndex
																		(- (length$ $?c) 1))))
;------------------------------------------------------------------------------
(defrule ConstructPathAggregateForRegion
			(declare (salience 100))
			(Stage WavefrontSchedule $?)
			(Substage Init $?)
			(object (is-a Hint) (Type Wavefront) (Parent ?r) (Contents $? ?e $?))
			?bb <- (object (is-a Region) (ID ?e))
			=>
			(assert (Propagate aggregates of ?e))
			(make-instance of PathAggregate (Parent ?e)))
;------------------------------------------------------------------------------


painter.clp actually draws

painter.clp actually draws

(load* /lib/chicanery.clp)
(defglobal MAIN
           ?*old-timestamp* = 0
           ?*max-factor* = 128
           ?*factor* = 1)

(defmethod on-resized
  "method to handle resizing of the window"
  ((?value SYMBOL (not (neq ?value FALSE TRUE))))
  (if (and ?value (< (getwindow) 0)) then
    (printout werror "ERROR: couldn't reattach to window" crlf)
    (exit)))

(definstances elements
              (menu1 of menu (menu-entries cut copy paste))
              (menu2 of menu (menu-entries eat sleep drink))
              (scratch-rect of rectangle (x 0) (y 0) (bx 0) (by 0))
              (pixel-image of image (rectangle [pixel])
                           (replicate TRUE)
                           (color (get-standard-color black))))

(deffacts query-operation
          (query input))

(defrule query-input
         ?f <- (query input)
         =>
         (retract ?f)
         (bind ?*old-timestamp* (send [mouse] get-timestamp))
         (send [mouse] query)
         (send [keyboard] query)
         (assert (check mouse)
                 (check keyboard)))

(defrule process-mouse-inputs
         (declare (salience -1))
         ?f <- (check mouse)
         =>
         (retract ?f)
         (assert (query mouse)))

(defrule process-mouse-inputs:button1
         ?f <- (check mouse)
         (object (is-a mouse)
                 (name [mouse])
                 (buttons button1)
                 (position ?x ?y))
         ?rect <- (object (is-a rectangle)
                          (name [scratch-rect]))
         =>
         (retract ?f)
         (modify-instance ?rect (x ?x) (y ?y)
                          (bx (+ ?x ?*factor*))
                          (by (+ ?y ?*factor*)))
         ;rebuild the native memory since we've made
         ; changes to the fields
         (send ?rect build-pointer)
         (screen/draw ?rect [pixel-image] [ZP])
         (assert (query mouse)))

(defrule process-mouse-inputs:menu1
         (declare (salience 1))
         ?f <- (check mouse)
         (object (is-a mouse)
                 (name [mouse])
                 (buttons button3))
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu1] show-menu 3) crlf)
         (assert (query mouse)))

(defrule process-mouse-inputs:menu2
         (declare (salience 1))
         ?f <- (check mouse)
         (object (is-a mouse)
                 (name [mouse])
                 (buttons button2)
                 (timestamp ?ts))
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu2] show-menu 2) crlf)
         (assert (query mouse)))

(defrule process-keyboard-inputs:quit
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys ESC))
         =>
         (retract ?f)
         (exit))

(defrule process-keyboard-inputs:nil
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys NIL))
         =>
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs:up
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys UP))
         =>
         (if (< ?*factor* ?*max-factor*) then
           (bind ?*factor* (+ ?*factor* 1)))
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs:down
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys DOWN))
         =>
         (if (>= ?*factor* 0) then
           (bind ?*factor* (- ?*factor* 1)))
         (retract ?f)
         (assert (query keyboard)))
(defrule process-keyboard-inputs
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys ?b&~NIL))
         =>
         (retract ?f)
         (printout t "Pressed " ?b crlf)
         (assert (query keyboard)))

(defrule ready-to-query-input-again
         ?f <- (query keyboard)
         ?f2 <- (query mouse)
         =>
         (retract ?f ?f2)
         (send [mouse] clear)
         (send [keyboard] clear)
         (assert (query input)))

(load* /lib/chicanery.clp)

(defglobal MAIN
           ?*system-initialized* = FALSE)

(deffacts query-operation
          (query input)
          (defmenu menu1 cut copy paste)
          (defmenu menu2 eat sleep drink))

(defrule initialize
         (declare (salience 10000))
         (initial-fact)
         =>
         (if (not ?*system-initialized*) then
           (eresized 0)
           (bind ?*system-initialized* TRUE)))

(defrule build-menus
         (declare (salience 9999))
         ?f <- (defmenu ?name $?entries)
         =>
         (retract ?f)
         (defmenu ?name ?entries))

(defrule on-resized
         (declare (salience 1000))
         ?f <- (event resized new ?value)
         =>
         (if (and ?value (< (getwindow) 0)) then
           (printout werror "ERROR: couldn't reattach to window" crlf)
           (exit)
           else
           (retract ?f)))

(defrule query-input
         ?f <- (query input)
         =>
         (retract ?f)
         (mouse/query)
         (assert (input mouse
                        buttons: (translate/mouse/buttons)
                        position: (mouse/position)
                        time-stamp: (mouse/timestamp))
                 (input keyboard
                        button: (translate/kbd/query))))

(defrule process-mouse-inputs
         (declare (salience -1))
         ?f <- (input mouse
                      buttons: $?
                      position: ? ?
                      time-stamp: ?)
         =>
         (retract ?f)
         (assert (query mouse)))

(defrule process-mouse-inputs:menu1
         ?f <- (input mouse
                      buttons: button3
                      position: ? ?
                      time-stamp: ?)
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu1] show-menu 3) crlf)
         (assert (query mouse)))

(defrule process-mouse-inputs:menu2
         ?f <- (input mouse
                      buttons: button2
                      position: ? ?
                      time-stamp: ?)
         =>
         (retract ?f)
         ; Display a menu
         (printout t (send [menu2] show-menu 2) crlf)
         (assert (query mouse)))

(defrule process-keyboard-inputs:quit
         (declare (salience 1))
         ?f <- (input keyboard
                      button: ESC)
         =>
         (retract ?f)
         (exit))

(defrule process-keyboard-inputs:nil
         (declare (salience 1))
         ?f <- (input keyboard
                      button: NIL)
         =>
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs
         ?f <- (input keyboard
                      button: ?b&~NIL)
         =>
         (retract ?f)
         (printout t "Pressed " ?b crlf)
         (assert (query keyboard)))

(defrule ready-to-query-input-again
         ?f <- (query keyboard)
         ?f2 <- (query mouse)
         =>
         (retract ?f ?f2)
         (assert (query input)))


just adding options to the menu

just adding options to the menu

(defrule ShowMainMenu

=>
	(printout t "- Infering relations about:" crlf)
	(printout t "      1- cousins " crlf)
	(printout t "      2- Nephews" crlf)
	(printout t "      3- Nieces" crlf)
	(printout t "      4- Uncle" crlf)
	(printout t "      5- Aunt" crlf)
	(printout t "      6- Grandfather" crlf)
	(printout t "      7- Grandmother" crlf)
	(printout t "- Familly knowledge base" crlf)
	(printout t "      8- Display a familly member by name" crlf)
	(printout t "      9- Display a familly member by parent" crlf)
	(printout t "      9- Add family member" crlf)
	(printout t "      11- Remove family member" crlf)
	(printout t "- Modify family member properties" crlf)
	(printout t "      8- Modify familly member name" crlf)
	(printout t "      9- Display a familly member by data" crlf)
	(printout t "      9- Add family member" crlf)
	(printout t "      11- Remove family member" crlf)
	(printout t "- Search familly members by properties" crlf)
	(printout t "      12- Show all individuals that match a combination of properties familly knowledge base" crlf)

	(bind ?selectedOption (read))

	(assert(Selected ?selectedOption))
)

(defrule GetQueryData
	(Selected 12)
=>
	(printout t "Enter the criteria to search upon in the same order, write 'all' if you do not care about a specific property:" crlf)

	(printout t "What is the gender ? (m or f) or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QueryGender ?answer))

	(printout t "What is the spouse name ? or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QuerySpouse ?answer))

	(printout t "What is the name of one of parents ?  or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QueryParent ?answer))

	(printout t "What is the name of one of siblings ?  or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QuerySiblings ?answer))

	(printout t "What is the height range ? (equals to|greater than|less than) then press enter then input the height  or write 'all'" crlf)
	(bind ?type (readline))
	(bind ?height (read))
	(assert (QueryHeight ?type ?height))
	(printout t ?type crlf)

)

(defrule ShowMainMenu

=>
	(printout t "- Infering relations about:" crlf)
	(printout t "      1- cousins " crlf)
	(printout t "      2- Nephews" crlf)
	(printout t "      3- Nieces" crlf)
	(printout t "      4- Uncle" crlf)
	(printout t "      5- Aunt" crlf)
	(printout t "      6- Grandfather" crlf)
	(printout t "      7- Grandmother" crlf)
	(printout t "- Modifiy familly knowledge base" crlf)
	(printout t "      8- Display a familly member by name" crlf)
	(printout t "      9- Display a familly member by data" crlf)
	(printout t "      9- Add family member" crlf)
	(printout t "      10- Modify family member properties" crlf)
	(printout t "      11- Remove family member" crlf)
	(printout t "- Search familly members by properties" crlf)
	(printout t "      12- Show all individuals that match a combination of properties familly knowledge base" crlf)

	(bind ?selectedOption (read))

	(assert(Selected ?selectedOption))
)

(defrule GetQueryData
	(Selected 12)
=>
	(printout t "Enter the criteria to search upon in the same order, write 'all' if you do not care about a specific property:" crlf)

	(printout t "What is the gender ? (m or f) or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QueryGender ?answer))

	(printout t "What is the spouse name ? or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QuerySpouse ?answer))

	(printout t "What is the name of one of parents ?  or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QueryParent ?answer))

	(printout t "What is the name of one of siblings ?  or write 'all'" crlf)
	(bind ?answer (read))
	(assert (QuerySiblings ?answer))

	(printout t "What is the height range ? (equals to|greater than|less than) then press enter then input the height  or write 'all'" crlf)
	(bind ?type (readline))
	(bind ?height (read))
	(assert (QueryHeight ?type ?height))
	(printout t ?type crlf)

)


Rearranged the matching rules for determinant matching.

;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.
;------------------------------------------------------------------------------
; FrequencyAnalysis.clp - Determines which regions to apply wavefront
; scheduling to
; Written by Joshua Scoggins (6/30/2012)
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant::InstanceFrequencyCounter
         "Creates a frequency counter hint for basic blocks"
         (declare (salience 2))
         (object (is-a Region)
                 (id ?p)
                 (class Region))
         (not (exists (object (is-a FrequencyAnalysis)
                              (parent ?p))))
         =>
         (make-instance of FrequencyAnalysis (parent ?p)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant::IncrementFrequencyCounter-BasicBlock
         "Goes through a given Region counting the number of basic blocks found
         within the region. Valid blocks are blocks that contain more than one
         instruction as we don't want to count JS nodes as they don't usually
         contain code."
         (declare (salience 1))
         ?wa <- (object (is-a FrequencyAnalysis)
                        (parent ?p))
         (object (is-a Region)
                 (id ?p)
                 (class Region)
                 (contents $? ?t $?))
         (object (is-a BasicBlock)
                 (id ?t)
                 (parent ?p)
                 (contents $?insts&:(> (length$ $?insts) 1)))
         =>
         (send ?wa increment-frequency))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant::ImplyEnoughBlocks
         "There are enough blocks within the target region to make it a
         candidate for wavefront scheduling. Make a hint that says this."
         ?fa <- (object (is-a FrequencyAnalysis)
                        (parent ?p)
                        (frequency ?z&:(and (< ?z 100) (> ?z 1))))
         ?region <- (object (is-a Region)
                            (id ?p)
                            (class Region))
         =>
         (assert (message (to wavefront-scheduling)
                          (action can-wavefront-schedule)
                          (arguments ?p))
                 (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?p))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant-cleanup::cleanup-frequency-analysis
         ?fct <- (message (from pipeline)
                          (to wavefront-scheduling-determinant-cleanup)
                          (action initial-fact))
         =>
         (retract ?fct)
         (progn$ (?fa (find-all-instances ((?freq FrequencyAnalysis)) TRUE))
                 (unmake-instance ?fa)))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
; FrequencyAnalysis.clp - Determines which regions to apply wavefront
; scheduling to
; Written by Joshua Scoggins (6/30/2012)
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant::InstanceFrequencyCounter
         "Creates a frequency counter hint for basic blocks"
         (declare (salience 2))
         (object (is-a Region)
                 (id ?p)
                 (class Region))
         (not (exists (object (is-a FrequencyAnalysis)
                              (parent ?p))))
         =>
         (make-instance of FrequencyAnalysis (parent ?p)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant::IncrementFrequencyCounter-BasicBlock
         "Goes through a given Region counting the number of basic blocks found
         within the region. Valid blocks are blocks that contain more than one
         instruction as we don't want to count JS nodes as they don't usually
         contain code."
         (declare (salience 1))
         (object (is-a Region)
                 (id ?p)
                 (class Region)
                 (contents $? ?t $?))
         (object (is-a BasicBlock)
                 (id ?t)
                 (parent ?p)
                 (contents $?insts&:(> (length$ $?insts) 1)))
         ?wa <- (object (is-a FrequencyAnalysis)
                        (parent ?p))
         =>
         (send ?wa increment-frequency))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant::ImplyEnoughBlocks
         "There are enough blocks within the target region to make it a
         candidate for wavefront scheduling. Make a hint that says this."
         ?fa <- (object (is-a FrequencyAnalysis)
                        (parent ?p)
                        (frequency ?z&:(and (< ?z 100) (> ?z 1))))
         ?region <- (object (is-a Region)
                            (id ?p)
                            (class Region))
         =>
         (assert (message (to wavefront-scheduling)
                          (action can-wavefront-schedule)
                          (arguments ?p))
                 (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?p))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-determinant-cleanup::cleanup-frequency-analysis
         ?fct <- (message (from pipeline)
                          (to wavefront-scheduling-determinant-cleanup)
                          (action initial-fact))
         =>
         (retract ?fct)
         (progn$ (?fa (find-all-instances ((?freq FrequencyAnalysis)) TRUE))
                 (unmake-instance ?fa)))
;------------------------------------------------------------------------------


del comment

del comment

; -*- clips -*-

;; **********************************************************************
;;                           Frame.clp
;;
;; A nifty example of building a a Swing GUI using jess reflection.
;; Using this package, we can create java objects, call their methods,
;; access their fields, and respond to GUI events.
;; You can therefore build an entire GUI application without actually
;; writing any Java code!
;;
;; **********************************************************************

;; ******************************
;; Declarations

(import javax.swing.*)
;; Explicit import so we get JFrame.EXIT_ON_CLOSE
(import javax.swing.JFrame)
(import java.awt.event.ActionListener)
(import java.awt.BorderLayout)
(import java.awt.Color)

;; ******************************
;; DEFGLOBALS

(defglobal ?*f* = 0)
(defglobal ?*c* = 0)
(defglobal ?*d* = 0)
(defglobal ?*e* = 0)

(defglobal ?*m* = 0)
(defglobal ?*envi* = 0)

;; ******************************
;; DEFFUNCTIONS

(deffunction create-frame ()
  (bind ?*f* (new JFrame "Jess Reflection Demo"))
  (bind ?*c* (?*f* getContentPane))
  (set ?*c* background (Color.magenta)))

(deffunction add-widgets ()
  (?*c* add (new JLabel "This is: ") (BorderLayout.CENTER))
  (bind ?*m* (new JComboBox))
  (bind ?*d* (new JComboBox))
  (bind ?*e* (new JComboBox))
  (?*m* addItem "paper")
  (?*m* addItem "tools")
  (?*m* addItem "buildings")
  (?*m* addItem "numbers")
  (?*c* add ?*m* (BorderLayout.SOUTH))
  (bind ?*envi* ?*m* selectedItem)
  (assert (environment ?*envi*))
  (?*e* addItem "paper")
  (?*e* addItem "tools")
  (?*e* addItem "buildings")
  (?*e* addItem "numbers")
  (?*c* add ?*e* (BorderLayout.NORTH))
  (bind ?*envi* ?*m* selectedItem)
  (assert (environment ?*envi*))
  (?*d* addItem "paper")
  (?*d* addItem "tools")
  (?*d* addItem "buildings")
  (?*d* addItem "numbers")
  (?*c* add ?*d* )
  (bind ?*envi* ?*d* selectedItem )
  (assert (environment ?*envi*)))

(deffunction add-behaviours ()
  (?*f* setDefaultCloseOperation (JFrame.EXIT_ON_CLOSE))

  (?*m* addActionListener (implement ActionListener using
    (lambda (?name ?event)
      (printout t "You chose: " (get ?*m* selectedItem) crlf)))))

(deffunction show-frame ()
  ;(?*f* pack)
    (?*f* setSize 200 300)
  (?*f* setVisible TRUE))

;; ******************************
;; Run the program

(defrule init-rule
    (initial-fact)
    =>
    (create-frame)
    (add-widgets)
    (add-behaviours)
    (show-frame))

(reset)
(run)

;;test now 2
;;howareyougit
<<<<<<< HEAD
;;sadasdh
;asdhasdhoas;shdklfjhsdjk
=======
;;123131469564131345561
;;mmmark
;sdfsdfjklsdfh
>>>>>>> origin/master


Added the loop-region-merging pass to the PassRegistry

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PassRegistry.clp - Contains the listing of the standard set of passes.
;------------------------------------------------------------------------------
; If you want to define a group of passes to be executed without reset being
; called in between then define a pass but do not provide an entry point and a
; set of passes to execute in the passes multislot
;------------------------------------------------------------------------------

(definstances PersistentPassRegistry
 ([test] of Pass
  (entry-point "passes/test/PassHeader.clp")
  (pass-name test)
  (pass-description "A test of the indirect pass system")
  (pass-type Module)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes test)
  (required loops regions)
  (preserves-cfg TRUE)
  (preserves-all TRUE))
 ([paths] of Pass
  (entry-point "passes/path/all/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))
 ([paths-conditional] of Pass
  (entry-point "passes/path/conditional/PassHeader.clp")
  (pass-name paths-conditional)
  (pass-description "Generate the set of paths through a set of target regions")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths-conditional)
  (required loops regions))
 ([loop-region-merging] of Pass
  (entry-point "passes/loop-region-merging/PassHeader.clp")
  (pass-name loop-region-merging)
  (pass-description "Merges the loops and regions of a given function into a single logical CFG.")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes loop-region-merging)
  (required loops regions))

 ;Add more passes here
)
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PassRegistry.clp - Contains the listing of the standard set of passes.
;------------------------------------------------------------------------------
; If you want to define a group of passes to be executed without reset being
; called in between then define a pass but do not provide an entry point and a
; set of passes to execute in the passes multislot
;------------------------------------------------------------------------------

(definstances PersistentPassRegistry
 ([test] of Pass
  (entry-point "passes/test/PassHeader.clp")
  (pass-name test)
  (pass-description "A test of the indirect pass system")
  (pass-type Module)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes test)
  (required loops regions)
  (preserves-cfg TRUE)
  (preserves-all TRUE))
 ([paths] of Pass
  (entry-point "passes/path/all/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))
 ([paths-conditional] of Pass
  (entry-point "passes/path/conditional/PassHeader.clp")
  (pass-name paths-conditional)
  (pass-description "Generate the set of paths through a set of target regions")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths-conditional)
  (required loops regions))
 ;Add more passes here
)
;------------------------------------------------------------------------------


Fixed bugs in WavefrontPropagation.clp

Fixed bugs in WavefrontPropagation.clp

I had given $?elements the name $?targets in my rewrite of one of the phi
functions. I have reverted this.

I had also made it so that the result of (/ (length$ $?elements) 2) was not
being bound to a variable and instead was being passed directly to the
create-phi-node function. This has been fixed.

;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)
                        (InstructionPropagation $?ip))
         (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)
         (modify-instance ?pa (InstructionPropagation $?ip ?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)
                        (InstructionPropagation $?ip))
         (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)
         (modify-instance ?pa (InstructionPropagation $?ip ?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 => $?targets))
         ?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))
         ;make the phinode in LLVM and get it's address back
         (bind ?phiPtr
               (llvm-make-phi-node ?name
                                   ?typePtr
                                   (/ (length$ $?elements) 2)
                                   ?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))
;------------------------------------------------------------------------------