Simplified the pointer field in Environment

This was done to take advantage of the composite source fact

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Environment.clp - A wrapper over a CLIPS environment
;------------------------------------------------------------------------------
(defclass core::Environment
 "A wrapper over a clips environment"
 (is-a Object InteropObject)
 (role concrete)
 (slot pointer (source composite) (access initialize-only)
  (visibility public) (range 0 0) (default-dynamic 0)))

(defmessage-handler core::Environment init around ()
 (call-next-handler)
 (if (eq ?self:pointer 0) then
  (bind ?self:pointer (env-create))))

(defmessage-handler core::Environment destroy primary ()
                    (if (not (is-currently-executing-environment ?self:pointer)) then
                      (env-destroy ?self:pointer)
                      (return (delete-instance))
                      else
                      (printout
                        werror
                        "ERROR: attempted to destroy the executing environment."
                        crlf)
                      (return FALSE)))

(defmessage-handler core::Environment is-currently-executing-environment primary ()
                    (return (is-currently-executing-environment ?self:pointer)))

(defmessage-handler core::Environment run ($?count)
                    (bind ?size (length$ $?count))
                    (if (= 0 ?size) then
                      (if (is-currently-executing-environment ?self:pointer) then
                        (run)
                        else
                        (env-run ?self:pointer))
                      else
                      (bind ?num (nth$ 1 ?count))
                      (if (and (> ?num 0) (integerp ?num)) then
                        (if (is-currently-executing-environment ?self:pointer) then
                          (run ?num)
                          else
                          (env-run ?self:pointer ?num))
                        else
                        (printout werror "ERROR: invalid count provided." crlf))))

(defmessage-handler core::Environment eval (?string)
                    (if (stringp ?string) then
                      (if (is-currently-executing-environment ?self:pointer) then
                        (eval ?string)
                        else
                        (env-eval ?self:pointer ?string))
                      else
                      (printout werror "ERROR: string expected" crlf)))

(defmessage-handler core::Environment build (?string)
                    (if (stringp ?string) then
                      (if (is-currently-executing-environment ?self:pointer) then
                        (build ?string)
                        else
                        (env-build ?self:pointer ?string))
                      else
                      (printout werror "ERROR: string expected" crlf)))

(defmessage-handler core::Environment facts ()
                    (if (is-currently-executing-environment ?self:pointer) then
                      (facts)
                      else
                      (env-facts ?self:pointer)))
(defmessage-handler core::Environment instances ()
                    (if (is-currently-executing-environment ?self:pointer) then
                      (instances)
                      else
                      (env-instances ?self:pointer)))

(defmessage-handler core::Environment rules ()
                    (if (is-currently-executing-environment ?self:pointer) then
                      (rules)
                      else
                      (env-rules ?self:pointer)))

(defmessage-handler core::Environment assert ($?elements)
                    (bind ?length (length$ ?elements))
                    (if (= 0 ?length) then
                      (printout werror "ERROR: No arguments provided" crlf)
                      else
                      (env-assert-string ?self:pointer
							  (implode$ $?elements))))

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Environment.clp - A wrapper over a CLIPS environment
;------------------------------------------------------------------------------
(defclass core::Environment
 "A wrapper over a clips environment"
 (is-a Object InteropObject)
 (slot pointer (type INTEGER EXTERNAL-ADDRESS) (source composite) (access initialize-only)
  (range 0 0) (default-dynamic 0)))

(defmessage-handler core::Environment init around ()
 (call-next-handler)
 (if (eq ?self:pointer 0) then
  (bind ?self:pointer (env-create))))

(defmessage-handler core::Environment destroy primary ()
                    (if (not (is-currently-executing-environment ?self:pointer)) then
                      (env-destroy ?self:pointer)
                      (return (delete-instance))
                      else
                      (printout
                        werror
                        "ERROR: attempted to destroy the executing environment."
                        crlf)
                      (return FALSE)))

(defmessage-handler core::Environment is-currently-executing-environment primary ()
                    (return (is-currently-executing-environment ?self:pointer)))

(defmessage-handler core::Environment run ($?count)
                    (bind ?size (length$ $?count))
                    (if (= 0 ?size) then
                      (if (is-currently-executing-environment ?self:pointer) then
                        (run)
                        else
                        (env-run ?self:pointer))
                      else
                      (bind ?num (nth$ 1 ?count))
                      (if (and (> ?num 0) (integerp ?num)) then
                        (if (is-currently-executing-environment ?self:pointer) then
                          (run ?num)
                          else
                          (env-run ?self:pointer ?num))
                        else
                        (printout werror "ERROR: invalid count provided." crlf))))

(defmessage-handler core::Environment eval (?string)
                    (if (stringp ?string) then
                      (if (is-currently-executing-environment ?self:pointer) then
                        (eval ?string)
                        else
                        (env-eval ?self:pointer ?string))
                      else
                      (printout werror "ERROR: string expected" crlf)))

(defmessage-handler core::Environment build (?string)
                    (if (stringp ?string) then
                      (if (is-currently-executing-environment ?self:pointer) then
                        (build ?string)
                        else
                        (env-build ?self:pointer ?string))
                      else
                      (printout werror "ERROR: string expected" crlf)))

(defmessage-handler core::Environment facts ()
                    (if (is-currently-executing-environment ?self:pointer) then
                      (facts)
                      else
                      (env-facts ?self:pointer)))
(defmessage-handler core::Environment instances ()
                    (if (is-currently-executing-environment ?self:pointer) then
                      (instances)
                      else
                      (env-instances ?self:pointer)))

(defmessage-handler core::Environment rules ()
                    (if (is-currently-executing-environment ?self:pointer) then
                      (rules)
                      else
                      (env-rules ?self:pointer)))

(defmessage-handler core::Environment assert ($?elements)
                    (bind ?length (length$ ?elements))
                    (if (= 0 ?length) then
                      (printout werror "ERROR: No arguments provided" crlf)
                      else
                      (env-assert-string ?self:pointer
							  (implode$ $?elements))))


Modulized the GLConstantConversion expert system

This makes the set of rules cleaner by not continually relying on salience
values to order the rules. The modules to it instead

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
(defmodule types
           (export ?ALL))
;------------------------------------------------------------------------------
(defmodule identify-lines
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule convert-templates
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule build-groups
           (import types ?ALL))
;------------------------------------------------------------------------------
(defclass types::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 types::opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate types::file-line
             (slot index)
             (slot parent)
             (slot type)
             (multifield contents))
;------------------------------------------------------------------------------
(deftemplate types::heading-span
             "Defines a span between two different headings"
             (slot header-name)
             (multislot contents)
             (slot from)
             (slot to)
             (slot parent)
             (slot distance))
;------------------------------------------------------------------------------
(deftemplate types::message
             (slot from)
             (slot to)
             (slot action)
             (multislot arguments))
;------------------------------------------------------------------------------
(defclass types::line-entry
  (is-a USER)
  (slot id)
  (slot index)
  (slot parent)
  (slot type)
  (multifield contents))
;------------------------------------------------------------------------------
(defmessage-handler types::line-entry init after ()
                    (bind ?self:id (instance-name-to-symbol (instance-name ?self))))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction types::get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule MAIN::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))
           (focus identify-lines convert-templates build-groups)
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule identify-lines::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 identify-lines::retract-unknowns
         (declare (salience -10))
         ?f <- (file-line (type UNKNOWN))
         =>
         (retract ?f))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (file-line (type UNKNOWN)
                          (contents /* $? */))
         =>
         (modify ?f (type heading)))
;------------------------------------------------------------------------------
(defrule identify-lines::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 identify-lines::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 identify-lines::mark-glapi-calls
         "marks glapi calls"
         ?f <- (file-line (type UNKNOWN)
                          (contents GLAPI $? "(" $? ")"))
         =>
         (modify ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule identify-lines::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)))
;------------------------------------------------------------------------------
(defrule identify-lines::define-header-spans-initial
         "Defines spans between headers"
         (declare (salience -3))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i)
                    (contents /* $?name */))
         (not (exists (heading-span (from ?i)
                                    (parent ?parent))))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i2&:(> ?i2 ?i)))
         =>
         (bind ?difference (- ?i2 ?i))
         (if (> ?difference 0) then
           (assert (heading-span (header-name (implode$ $?name))
                                 (from ?i)
                                 (to ?i2)
                                 (parent ?parent)
                                 (distance ?difference)))))
;------------------------------------------------------------------------------
(defrule identify-lines::modify-header-spans-for-smaller-size
         "Retracts the heading-span in response to finding an earlier heading"
         ?f <- (heading-span (from ?i)
                             (to ?j)
                             (parent ?parent))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i2&:(> ?j ?i2 ?i)))
         =>
         (modify ?f (to ?i2)
                 (distance (- ?i2 ?i))))
;------------------------------------------------------------------------------
(defrule convert-templates::convert-line-objects
         ?f <- (file-line (type ?t) (parent ?p) (index ?i)
                          (contents $?c))
         =>
         (retract ?f)
         (bind ?name (gensym*))
         (assert (message (to build-groups)
                          (action add-to-span)
                          (arguments ?name)))
         (make-instance ?name of line-entry
                        (type ?t)
                        (parent ?p)
                        (index ?i)
                        (contents $?c)))
;------------------------------------------------------------------------------
(defrule build-groups::build-grouping
         ?f <- (heading-span (from ?i)
                             (to ?i2)
                             (parent ?parent)
                             (contents $?c))
         (object (is-a line-entry)
                 (parent ?parent)
                 (index ?loc&:(> ?i2 ?loc ?i))
                 (id ?id))
         ?msg <- (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))
         =>
         (retract ?msg)
         (modify ?f (contents $?c ?id)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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))
;------------------------------------------------------------------------------
(deftemplate heading-span
             "Defines a span between two different headings"
             (slot from)
             (slot to)
             (slot parent)
             (slot distance))
;------------------------------------------------------------------------------
; 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)))
;------------------------------------------------------------------------------
(defrule define-header-spans-initial
         "Defines spans between headers"
         (declare (salience -3))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i))
         (not (exists (heading-span (from ?i)
                                    (parent ?parent))))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i2&:(> ?i2 ?i)))
         =>
         (bind ?difference (- ?i2 ?i))
         (if (> ?difference 0) then
           (assert (heading-span (from ?i)
                                 (to ?i2)
                                 (parent ?parent)
                                 (distance ?difference)))))
;------------------------------------------------------------------------------
(defrule modify-header-spans-for-smaller-size
         "Retracts the heading-span in response to finding an earlier heading"
         ?f <- (heading-span (from ?i)
                             (to ?j)
                             (parent ?parent))
         (file-line (type heading)
                    (parent ?parent)
                    (index ?i2&:(> ?j ?i2 ?i)))
         =>
         (modify ?f (to ?i2)
                 (distance (- ?i2 ?i))))
;------------------------------------------------------------------------------


cfp and propose are now in capital letters.

;/*****************************************************************
;JADE - Java Agent DEvelopment Framework is a framework to develop
;multi-agent systems in ;compliance with the FIPA specifications.
;Copyright (C) 2000 CSELT S.p.A.
;
;GNU Lesser General Public License
;
;This library is free software; you can redistribute it and/or
;modify it under the terms of the GNU Lesser General Public
;License as published by the Free Software Foundation,
;version 2.1 of the License.
;
;This library is distributed in the hope that it will be useful,
;but WITHOUT ANY WARRANTY; without even the implied warranty of
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;Lesser General Public License for more details.
;
;You should have received a copy of the GNU Lesser General Public
;License along with this library; if not, write to the
;Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;Boston, MA  02111-1307, USA.
;*****************************************************************/

;/**
;
;@author Fabio Bellifemine - CSELT S.p.A
;@version $Date$ $Revision$
;*/
;
; 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)
;              (slot encoding) (multislot reply-to) (slot reply-by))
; refer to Fipa2000 (www.fipa.org) 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)
(watch all)
(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.

;/*****************************************************************
;JADE - Java Agent DEvelopment Framework is a framework to develop
;multi-agent systems in ;compliance with the FIPA specifications.
;Copyright (C) 2000 CSELT S.p.A.
;
;GNU Lesser General Public License
;
;This library is free software; you can redistribute it and/or
;modify it under the terms of the GNU Lesser General Public
;License as published by the Free Software Foundation,
;version 2.1 of the License.
;
;This library is distributed in the hope that it will be useful,
;but WITHOUT ANY WARRANTY; without even the implied warranty of
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;Lesser General Public License for more details.
;
;You should have received a copy of the GNU Lesser General Public
;License along with this library; if not, write to the
;Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;Boston, MA  02111-1307, USA.
;*****************************************************************/

;/**
;
;@author Fabio Bellifemine - CSELT S.p.A
;@version $Date$ $Revision$
;*/
;
; 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)
;              (slot encoding) (multislot reply-to) (slot reply-by))
; refer to Fipa2000 (www.fipa.org) 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.


no message

no message

;/*****************************************************************
;JADE - Java Agent DEvelopment Framework is a framework to develop multi-agent systems in ;compliance with the FIPA specifications.
;Copyright (C) 2000 CSELT S.p.A.
;
;GNU Lesser General Public License
;
;This library is free software; you can redistribute it and/or
;modify it under the terms of the GNU Lesser General Public
;License as published by the Free Software Foundation,
;version 2.1 of the License.
;
;This library is distributed in the hope that it will be useful,
;but WITHOUT ANY WARRANTY; without even the implied warranty of
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;Lesser General Public License for more details.
;
;You should have received a copy of the GNU Lesser General Public
;License along with this library; if not, write to the
;Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;Boston, MA  02111-1307, USA.
;*****************************************************************/

;/**
;
;@author Fabio Bellifemine - CSELT S.p.A
;@version $Date$ $Revision$
;*/
;
; 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.

;/*****************************************************************
;JADE - Java Agent DEvelopment Framework is a framework to develop multi-agent systems in ;compliance with the FIPA specifications.
;Copyright (C) 2000 CSELT S.p.A.
;
;GNU Lesser General Public License
;
;This library is free software; you can redistribute it and/or
;modify it under the terms of the GNU Lesser General Public
;License as published by the Free Software Foundation,
;version 2.1 of the License.
;
;This library is distributed in the hope that it will be useful,
;but WITHOUT ANY WARRANTY; without even the implied warranty of
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;Lesser General Public License for more details.
;
;You should have received a copy of the GNU Lesser General Public
;License along with this library; if not, write to the
;Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;Boston, MA  02111-1307, USA.
;*****************************************************************/

;/**
;Javadoc documentation for the file
;@author Giovanni Rimassa - Universita` di Parma
;@version $Date$ $Revision$
;*/
;
; 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.


Added parsing support for glu.h

Added parsing support for glu.h

I have already tested the code and each file is generates itself separately.
This is due to the "continuation" behavior that the MAIN module demonstrates
through the use of the focus command. The MAIN module is pushed onto the stack
first before the other modules. This allows any other parse facts to be
processed and the procedure to occur again.

This make the process of conversion very automated.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; RunGLAPIConversion.clp - Runs the GLAPIConversion expert system
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
(clear)
(batch* GLAPIConversionEntry.clp)
(reset)
;Input format is the same as the constant conversion expert system
(assert (parse constant file "/usr/include/GL/gl.h")
		  (parse constant file "/usr/include/GL/glu.h"))
(run)
(exit)

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; RunGLAPIConversion.clp - Runs the GLAPIConversion expert system
; Written by Joshua Scoggins
;------------------------------------------------------------------------------
(clear)
(batch* GLAPIConversionEntry.clp)
(reset)
;Input format is the same as the constant conversion expert system
(assert (parse constant file "/usr/include/GL/gl.h"))
(run)
(exit)


Added a existence check to MarkNonLocalDependencies to prevent an infinite loop

;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)
                 (values $? ?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 Object&~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 Object&~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 Object&~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))
         =>
         (if (not (member$ ?o $?nld)) then
         (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 wavefront-scheduling-merge-update::RemoveInstructionsFromProducers
         (declare (salience 768))
         ?fct <- (message (to wavefront-scheduling)
                          (action remove-evidence)
                          (arguments ?tInst => ?inst $?insts))
         ?iObj <- (object (is-a Instruction)
                          (id ?inst)
                          (NonLocalDependencies $?nld)
                          (Producers $?pb ?tInst $?pa)
                          (LocalDependencies $?ldb ?tInst $?lda))
         =>
         (modify ?fct (arguments ?tInst => $?insts))
         (modify-instance ?iObj (Producers $?pb $?pa)
                          (LocalDependencies $?ldb $?lda)
                          (NonLocalDependencies $?nld ?tInst)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RetractRemoveInstructionsFromProducers
         (declare (salience 768))
         ?fct <- (message (to wavefront-scheduling)
                          (action remove-evidence)
                          (arguments ? =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::StartRecomputeBlock
         (declare (salience 100))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block)
                          (arguments ?b))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (contents $?instructions ?last))
         (object (is-a TerminatorInstruction)
                 (id ?last))
         =>
         (modify-instance ?bb
                          (ReadsFrom)
                          (WritesTo)
                          (HasMemoryBarrier FALSE))
         (modify ?fct
                 (action recompute-block-with-instructions)
                 (arguments ?b => $?instructions)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RecomputeNonMemoryInstructionForBlock
         (declare (salience 99))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b => ?inst $?rest))
         (object (is-a Instruction&~LoadInstruction&~StoreInstruction)
                 (id ?inst)
                 (parent ?b))
         =>
         (modify ?fct (arguments ?b => $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RecomputeLoadInstructionForBlock
         (declare (salience 99))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b => ?inst $?rest))
         (object (is-a LoadInstruction)
                 (id ?inst)
                 (parent ?b)
                 (MemoryTarget ?mt))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (ReadsFrom $?rf))
         =>
         (if (not (member$ ?mt $?rf)) then
           (modify-instance ?bb (ReadsFrom $?rf ?mt)))
         (modify ?fct (arguments ?b => $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RecomputeStoreInstructionForBlock
         (declare (salience 99))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b => ?inst $?rest))
         (object (is-a StoreInstruction)
                 (id ?inst)
                 (parent ?b)
                 (MemoryTarget ?mt))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (WritesTo $?wt))
         =>
         (if (not (member$ ?mt $?wt)) then
           (modify-instance ?bb (WritesTo $?wt ?mt)))
         (modify ?fct (arguments ?b => $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::FinishRecomputationForBlock
         (declare (salience 98))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b =>))
         ?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 wavefront-scheduling-dependency-analysis::CreateDependencyAnalysisTargets
         (declare (salience 10))
         (object (is-a Wavefront)
                 (parent ?r)
                 (values $? ?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 Object&~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 Object&~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 Object&~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 wavefront-scheduling-merge-update::RemoveInstructionsFromProducers
         (declare (salience 768))
         ?fct <- (message (to wavefront-scheduling)
                          (action remove-evidence)
                          (arguments ?tInst => ?inst $?insts))
         ?iObj <- (object (is-a Instruction)
                          (id ?inst)
                          (NonLocalDependencies $?nld)
                          (Producers $?pb ?tInst $?pa)
                          (LocalDependencies $?ldb ?tInst $?lda))
         =>
         (modify ?fct (arguments ?tInst => $?insts))
         (modify-instance ?iObj (Producers $?pb $?pa)
                          (LocalDependencies $?ldb $?lda)
                          (NonLocalDependencies $?nld ?tInst)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RetractRemoveInstructionsFromProducers
         (declare (salience 768))
         ?fct <- (message (to wavefront-scheduling)
                          (action remove-evidence)
                          (arguments ? =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::StartRecomputeBlock
         (declare (salience 100))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block)
                          (arguments ?b))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (contents $?instructions ?last))
         (object (is-a TerminatorInstruction)
                 (id ?last))
         =>
         (modify-instance ?bb
                          (ReadsFrom)
                          (WritesTo)
                          (HasMemoryBarrier FALSE))
         (modify ?fct
                 (action recompute-block-with-instructions)
                 (arguments ?b => $?instructions)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RecomputeNonMemoryInstructionForBlock
         (declare (salience 99))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b => ?inst $?rest))
         (object (is-a Instruction&~LoadInstruction&~StoreInstruction)
                 (id ?inst)
                 (parent ?b))
         =>
         (modify ?fct (arguments ?b => $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RecomputeLoadInstructionForBlock
         (declare (salience 99))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b => ?inst $?rest))
         (object (is-a LoadInstruction)
                 (id ?inst)
                 (parent ?b)
                 (MemoryTarget ?mt))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (ReadsFrom $?rf))
         =>
         (if (not (member$ ?mt $?rf)) then
           (modify-instance ?bb (ReadsFrom $?rf ?mt)))
         (modify ?fct (arguments ?b => $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::RecomputeStoreInstructionForBlock
         (declare (salience 99))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b => ?inst $?rest))
         (object (is-a StoreInstruction)
                 (id ?inst)
                 (parent ?b)
                 (MemoryTarget ?mt))
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (WritesTo $?wt))
         =>
         (if (not (member$ ?mt $?wt)) then
           (modify-instance ?bb (WritesTo $?wt ?mt)))
         (modify ?fct (arguments ?b => $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-merge-update::FinishRecomputationForBlock
         (declare (salience 98))
         ?fct <- (message (to wavefront-scheduling)
                          (action recompute-block-with-instructions)
                          (arguments ?b =>))
         ?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))))
;------------------------------------------------------------------------------