Added a comment pertaining to a strange bug with [ ] in a doc string

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; GLAPIConversion.clp - an expert system that reads a define and generates
; corresponding CLIPS functions that convert the CLIPS values into
; corresponding opengl types. This gets a little goofy when dealing with
; multifields but the idea is sound.
;------------------------------------------------------------------------------
; We need to add functionality to diverge asterisks from a symbol
;------------------------------------------------------------------------------
(target-symbol-is-special "*"
								  identify-symbols-with-asterisks
								  "Splits asterisks (*) out of symbols if necessary")
;------------------------------------------------------------------------------
; Can't escape with double quotes with ] and [...strange
;------------------------------------------------------------------------------
(target-symbol-is-special "["
								  identify-symbols-with-open-square-bracket
								  "Splits an input string on [")
;------------------------------------------------------------------------------
(target-symbol-is-special "]"
								  identify-symbols-with-close-square-bracket
								  "Splits an input string on ]")
;------------------------------------------------------------------------------
; Unlike GLConstantConversion, I don't need to use the heading span objects.
; This is because each file-line has already been correctly merged.
;------------------------------------------------------------------------------
(defrule build-groups::delete-heading-span
			"We don't need heading spans in this expert system. So delete them"
			?obj <- (object (is-a heading-span))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------
; We need to define a transformation function/rule f which is responsible for
; taking in a knowledge representation of the original code from the input
; language and translates it to a knowledge representation of the code in the
; output language. In this case it is C => C with the added "benefit" of
; needing to add CLIPS api calls to interact with the overall environment.
;
; This isn't really that hard as what we need to do is just parse the arguments
; and generate the corresponding C code.
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name)
  (multislot arguments)
  (message-handler add-argument))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFunction add-argument
						  "Adds the arg name and returns the index"
						  (?name)
						  (bind ?index (length$ ?self:arguments))
						  (if (= 0 ?index) then
							 (slot-direct-insert$ arguments 1 ?name)
							 (return 1)
							 else
							 (slot-direct-insert$ arguments ?index ?name)
							 (return ?index)))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type (visibility public))
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
						  ()
						  (return (format nil "%s %s %s %s"
												(if ?self:is-constant then "const" else "")
												?self:argument-type
												(if ?self:is-pointer then "*" else "")
												?self:argument-name)))
;------------------------------------------------------------------------------
(defclass types::GLAPIFixedArrayArgument
  "Refers to fixed size arrays"
  (is-a GLAPIArgument)
  (slot array-size)
  (message-handler reconstitute around))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFixedArrayArgument reconstitute around
						  ()
						  (return (format nil "%s[%d]"
												(call-next-handler)
												?self:array-size)))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" $?args ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(modify ?msg (to grouping-update)
					  (action parse-arguments)
					  (arguments ?objName => $?args))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function-void
			(declare (salience 1))
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" void ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(retract ?msg)
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-fixed-size-array-argument
			(declare (salience 2))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry "[" ?size "]" ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIFixedArrayArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))
								(array-size ?size)))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-arguments-generic
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::create-last-argument
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(modify ?fct (action populate-argument)
					  (arguments ?name => $?all))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-empty-parse-message
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-pointer
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before "*" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-pointer TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-constant
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before const|"const" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-constant TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-core-info
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => ?type ?name))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(retract ?fct)
			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::printout-arguments
			(declare (salience -10))
			?obj <- (object (is-a GLAPIArgument))
			=>
			(printout t (send ?obj reconstitute) crlf))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; GLAPIConversion.clp - an expert system that reads a define and generates
; corresponding CLIPS functions that convert the CLIPS values into
; corresponding opengl types. This gets a little goofy when dealing with
; multifields but the idea is sound.
;------------------------------------------------------------------------------
; We need to add functionality to diverge asterisks from a symbol
;------------------------------------------------------------------------------
(target-symbol-is-special "*"
								  identify-symbols-with-asterisks
								  "Splits asterisks (*) out of symbols if necessary")
;------------------------------------------------------------------------------
(target-symbol-is-special "["
								  identify-symbols-with-open-square-bracket
								  "Splits an input string on [")
;------------------------------------------------------------------------------
(target-symbol-is-special "]"
								  identify-symbols-with-close-square-bracket
								  "Splits an input string on ]")
;------------------------------------------------------------------------------
; Unlike GLConstantConversion, I don't need to use the heading span objects.
; This is because each file-line has already been correctly merged.
;------------------------------------------------------------------------------
(defrule build-groups::delete-heading-span
			"We don't need heading spans in this expert system. So delete them"
			?obj <- (object (is-a heading-span))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------
; We need to define a transformation function/rule f which is responsible for
; taking in a knowledge representation of the original code from the input
; language and translates it to a knowledge representation of the code in the
; output language. In this case it is C => C with the added "benefit" of
; needing to add CLIPS api calls to interact with the overall environment.
;
; This isn't really that hard as what we need to do is just parse the arguments
; and generate the corresponding C code.
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name)
  (multislot arguments)
  (message-handler add-argument))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFunction add-argument
						  "Adds the arg name and returns the index"
						  (?name)
						  (bind ?index (length$ ?self:arguments))
						  (if (= 0 ?index) then
							 (slot-direct-insert$ arguments 1 ?name)
							 (return 1)
							 else
							 (slot-direct-insert$ arguments ?index ?name)
							 (return ?index)))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type (visibility public))
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
						  ()
						  (return (format nil "%s %s %s %s"
												(if ?self:is-constant then "const" else "")
												?self:argument-type
												(if ?self:is-pointer then "*" else "")
												?self:argument-name)))
;------------------------------------------------------------------------------
(defclass types::GLAPIFixedArrayArgument
  "Refers to fixed size arrays"
  (is-a GLAPIArgument)
  (slot array-size)
  (message-handler reconstitute around))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFixedArrayArgument reconstitute around
						  ()
						  (return (format nil "%s[%d]"
												(call-next-handler)
												?self:array-size)))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" $?args ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(modify ?msg (to grouping-update)
					  (action parse-arguments)
					  (arguments ?objName => $?args))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function-void
			(declare (salience 1))
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" void ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(retract ?msg)
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-fixed-size-array-argument
			(declare (salience 2))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry "[" ?size "]" ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIFixedArrayArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))
								(array-size ?size)))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-arguments-generic
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::create-last-argument
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(modify ?fct (action populate-argument)
					  (arguments ?name => $?all))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-empty-parse-message
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-pointer
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before "*" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-pointer TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-constant
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before const|"const" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-constant TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-core-info
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => ?type ?name))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(retract ?fct)
			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::printout-arguments
			(declare (salience -10))
			?obj <- (object (is-a GLAPIArgument))
			=>
			(printout t (send ?obj reconstitute) crlf))
;------------------------------------------------------------------------------


src/lib/widget/Library.clp: Added batch* statements to load starting objects

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Library.clp - Defines the widget module and loads all corresponding files.
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
; Define the module
;------------------------------------------------------------------------------
(defmodule widget
			  (import cortex ?ALL)
			  (export ?ALL))
;------------------------------------------------------------------------------
; Load the corresponding types and functions
;------------------------------------------------------------------------------
(batch* "lib/widget/WidgetEvent.clp")
(batch* "lib/widget/WidgetElement.clp")


Fixed a backwards logic condition in Pass.clp

The code of the pass was not being loaded because it would only occur if the
entry-point string returned a negative number...obviously this would never
occur so the reverse condition needed to be set.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (> (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (< (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------


Rewrote indirect::Pass to work with the functions defined in libpipeline_clips

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING))
  (slot pass-description (type STRING)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (register-pass ?self:pass-name
											  ?self:pass-description
											  ?self:pass-type
											  ?self:is-analysis
											  ?self:is-cfg
											  ?self:need-regions
											  ?self:need-loops
											  ?self:passes
											  ?self:required
											  ?self:required-transitive
											  ?self:preserved
											  ?self:preserves-all
											  ?self:preserves-cfg))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING))
  (slot pass-description (type STRING)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot entry (type STRING))
  (slot target (type SYMBOL) (allowed-symbols Any Module Function Region Loop
                                              BasicBlock Instruction Immutable))
  (multislot pass-uses (type SYMBOL STRING INSTANCE-NAME)
             (allowed-classes PassBase)))
;------------------------------------------------------------------------------


Create task1.clp

Create task1.clp

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


Fixed bugs in PathUpdate.clp

Fixed bugs in PathUpdate.clp

I was trying to do a direct slot modify of a slot that didn't exist because
"values" only exists in Hint and it's subtypes. The slot "contents" is used as
the standard backing for everything that inherits from list.

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-region
			(object (is-a Region) (id ?r))
			(not (exists (object (is-a OwnershipDeterminant) (parent ?r))))
			=>
			(make-instance of OwnershipDeterminant (parent ?r)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-basicblock
			(object (is-a BasicBlock) (id ?b))
			(not (exists (object (is-a OwnershipDeterminant) (parent ?b))))
			=>
			(make-instance of OwnershipDeterminant (parent ?b)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-population::populate-determinant
 			?fct <- (message (to loop-region-merging)
				(action claim-owns)
				(arguments ?a => ?b))
			?obj <- (object (is-a OwnershipDeterminant) (parent ?b))
			?obj2 <- (object (is-a OwnershipDeterminant) (parent ?a))
			=>
			(retract ?fct)
      (object-pattern-match-delay
			(slot-insert$ ?obj2 PotentialChildren 1 ?b)
			(slot-insert$ ?obj Claims 1 ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-resolution::determine-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant) (parent ?b)
								(Claims $?v ?a $?x) (IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant) (parent ~?b)
					  (PotentialChildren $? ?b $?) (Claims $? ?a $?))
			?t1 <- (object (is-a OwnershipDeterminant) (parent ?a)
								(PotentialChildren $?t ?b $?r))
			=>
			;let's see if this is faster
      (object-pattern-match-delay
      (modify-instance ?t0 (IndirectClaims ?ic ?a) (Claims ?v ?x))
      (modify-instance ?t1 (PotentialChildren ?t ?r))))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-indirect-resolution::determine-indirect-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant) (parent ?b)
								(Claims $?l ?a $?x) (IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant) (parent ~?b&~?a)
					  (IndirectClaims $? ?a $?) (PotentialChildren $? ?b $?))
			?t1 <- (object (is-a OwnershipDeterminant) (parent ?a)
								(PotentialChildren $?z ?b $?q))
			=>
      (object-pattern-match-delay
       (modify-instance ?t0 (IndirectClaims ?ic ?a) (Claims ?l ?x))
       (modify-instance ?t1 (PotentialChildren ?z ?q))))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::delete-non-existent-references
			?region <- (object (is-a Region) (contents $? ?b $?))
			(not (exists (object (id ?b))))
			=>
      (object-pattern-match-delay
			(bind ?ind0 (member$ ?b (send ?region get-contents)))
			(slot-delete$ ?region contents ?ind0 ?ind0)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-region
			(object (is-a OwnershipDeterminant) (parent ?p) (Claims ?a))
			?obj <- (object (is-a Region) (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-basicblock
			(object (is-a OwnershipDeterminant) (parent ?p)
					  (Claims ?a))
			?obj <- (object (is-a BasicBlock) (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::add-new-child-to-target-region
			(object (is-a OwnershipDeterminant) (parent ?p)
					  (PotentialChildren $? ?a $?))
			?region <- (object (is-a Region) (id ?p) (contents $?c))
      (test (not (member$ ?a ?c)))
			=>
			(slot-insert$ ?region contents 1 ?a))
;------------------------------------------------------------------------------
(defrule loop-region-merging-cleanup-merger::cleanup-ownership-determinants
			"Deletes all of the OwnershipDeterminant objects in a single rule
			fire"
			?f0 <- (delete ownership-determinants)
			=>
			(retract ?f0)
			(progn$ (?obj (find-all-instances ((?list OwnershipDeterminant))
														 TRUE))
					  (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-rename::remove-unowned-elements
			"Now that we have figured out and updated ownership claims it is
			necessary to remove leftover entries in other regions"
			?r <- (object (is-a Region) (id ?t) (contents $?a ?b $?c))
			(object (is-a ParentedObject) (id ?b) (parent ~?t))
			=>
			(modify-instance ?r (contents $?a $?c)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-too-many-claims-of-ownership
			(object (is-a OwnershipDeterminant) (parent ?a)
					  (Claims $?z&:(> (length$ ?z) 1))
					  (id ?name))
			=>
			(printout t "ERROR: " ?name " has more than one claim of ownership on"
						 " it!" crlf "The claims are " ?z crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-region
			(object (is-a OwnershipDeterminant) (parent ?a) (Claims)
					  (PotentialChildren $?pc) (IndirectClaims $?ic))
			(object (is-a Region) (id ?a) (IsTopLevelRegion FALSE))
			=>
			(printout t "ERROR: " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-basicblock
			(object (is-a OwnershipDeterminant) (parent ?a) (Claims)
					  (PotentialChildren $?pc) (IndirectClaims $?ic))
			(object (is-a BasicBlock) (id ?a))
			=>
			(printout t "ERROR: BasicBlock " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-region
			(object (is-a Region) (id ?r))
			(not (exists (object (is-a OwnershipDeterminant) (parent ?r))))
			=>
			(make-instance of OwnershipDeterminant (parent ?r)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-construction::construct-determinant-for-basicblock
			(object (is-a BasicBlock) (id ?b))
			(not (exists (object (is-a OwnershipDeterminant) (parent ?b))))
			=>
			(make-instance of OwnershipDeterminant (parent ?b)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-population::populate-determinant
			?fct <- (claim ?a owns ?b)
			?obj <- (object (is-a OwnershipDeterminant) (parent ?b))
			?obj2 <- (object (is-a OwnershipDeterminant) (parent ?a))
			=>
			(retract ?fct)
      (object-pattern-match-delay
			(slot-insert$ ?obj2 PotentialChildren 1 ?b)
			(slot-insert$ ?obj Claims 1 ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-resolution::determine-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant) (parent ?b)
								(Claims $?v ?a $?x) (IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant) (parent ~?b)
					  (PotentialChildren $? ?b $?) (Claims $? ?a $?))
			?t1 <- (object (is-a OwnershipDeterminant) (parent ?a)
								(PotentialChildren $?t ?b $?r))
			=>
			;let's see if this is faster
      (object-pattern-match-delay
      (modify-instance ?t0 (IndirectClaims ?ic ?a) (Claims ?v ?x))
      (modify-instance ?t1 (PotentialChildren ?t ?r))))
;------------------------------------------------------------------------------
(defrule loop-region-merging-determinant-indirect-resolution::determine-indirect-indirect-claim
			?t0 <- (object (is-a OwnershipDeterminant) (parent ?b)
								(Claims $?l ?a $?x) (IndirectClaims $?ic))
			(object (is-a OwnershipDeterminant) (parent ~?b&~?a)
					  (IndirectClaims $? ?a $?) (PotentialChildren $? ?b $?))
			?t1 <- (object (is-a OwnershipDeterminant) (parent ?a)
								(PotentialChildren $?z ?b $?q))
			=>
      (object-pattern-match-delay
       (modify-instance ?t0 (IndirectClaims ?ic ?a) (Claims ?l ?x))
       (modify-instance ?t1 (PotentialChildren ?z ?q))))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::delete-non-existent-references
			?region <- (object (is-a Region) (contents $? ?b $?))
			(not (exists (object (id ?b))))
			=>
      (object-pattern-match-delay
			(bind ?ind0 (member$ ?b (send ?region get-contents)))
			(slot-delete$ ?region contents ?ind0 ?ind0)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-region
			(object (is-a OwnershipDeterminant) (parent ?p) (Claims ?a))
			?obj <- (object (is-a Region) (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::update-owner-of-target-basicblock
			(object (is-a OwnershipDeterminant) (parent ?p)
					  (Claims ?a))
			?obj <- (object (is-a BasicBlock) (id ?p))
			=>
			(modify-instance ?obj (parent ?a)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-update::add-new-child-to-target-region
			(object (is-a OwnershipDeterminant) (parent ?p)
					  (PotentialChildren $? ?a $?))
			?region <- (object (is-a Region) (id ?p) (contents $?c))
      (test (not (member$ ?a ?c)))
			=>
			(slot-insert$ ?region values 1 ?a))
;------------------------------------------------------------------------------
(defrule loop-region-merging-cleanup-merger::cleanup-ownership-determinants
			"Deletes all of the OwnershipDeterminant objects in a single rule
			fire"
			?f0 <- (delete ownership-determinants)
			=>
			(retract ?f0)
			(progn$ (?obj (find-all-instances ((?list OwnershipDeterminant))
														 TRUE))
					  (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup-rename::remove-unowned-elements
			"Now that we have figured out and updated ownership claims it is
			necessary to remove leftover entries in other regions"
			?r <- (object (is-a Region) (id ?t) (contents $?a ?b $?c))
			(object (is-a ParentedObject) (id ?b) (parent ~?t))
			=>
			(modify-instance ?r (values $?a $?c)))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-too-many-claims-of-ownership
			(object (is-a OwnershipDeterminant) (parent ?a)
					  (Claims $?z&:(> (length$ ?z) 1))
					  (id ?name))
			=>
			(printout t "ERROR: " ?name " has more than one claim of ownership on"
						 " it!" crlf "The claims are " ?z crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-region
			(object (is-a OwnershipDeterminant) (parent ?a) (Claims)
					  (PotentialChildren $?pc) (IndirectClaims $?ic))
			(object (is-a Region) (id ?a) (IsTopLevelRegion FALSE))
			=>
			(printout t "ERROR: " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------
(defrule loop-region-merging-fixup::FAILURE-no-remaining-claims-for-basicblock
			(object (is-a OwnershipDeterminant) (parent ?a) (Claims)
					  (PotentialChildren $?pc) (IndirectClaims $?ic))
			(object (is-a BasicBlock) (id ?a))
			=>
			(printout t "ERROR: BasicBlock " ?a " has no remaining claims!" crlf
						 ?a " has " $?pc " as it's potential children." crlf
						 ?a " has " $?ic " as it's indirect claims." crlf)
			(exit))
;------------------------------------------------------------------------------


Updated WavefrontDeterminantLogic.clp to use the new determinant module name

;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))
			=>
			(unmake-instance ?fa)
			(assert (message (to wavefront-scheduling)
								  (action can-wavefront-schedule)
								  (argument ?p))
					  (message (to path-conditional)
								  (action valid-pathing-target)
								  (arguments ?p))))
;------------------------------------------------------------------------------

;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-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-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-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))
			=>
			(unmake-instance ?fa)
			(assert (message (to wavefront-scheduling)
								  (action can-wavefront-schedule)
								  (argument ?p))
					  (message (to path-conditional)
								  (action valid-pathing-target)
								  (arguments ?p))))
;------------------------------------------------------------------------------


GLAPIConversionTypes.clp: Gave most slots public visibility for code gen

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; GLAPIConversionTypes.clp - Functions for the glapi conversion expert
; system
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type (visibility public))
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
						  ()
						  (return (format nil "%s %s %s %s"
												(if ?self:is-constant then "const" else "")
												?self:argument-type
												(if ?self:is-pointer then "*" else "")
												?self:argument-name)))
;------------------------------------------------------------------------------
(defclass types::GLAPIFixedArrayArgument
  "Refers to fixed size arrays"
  (is-a GLAPIArgument)
  (slot array-size)
  (message-handler reconstitute around))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFixedArrayArgument reconstitute around
						  ()
						  (return (format nil "%s[%s]"
												(call-next-handler)
												(str-cat ?self:array-size))))
;------------------------------------------------------------------------------
(defclass types::FunctionBuilder
  "Builds C functions"
  (is-a Object)
  (multislot contents))
;------------------------------------------------------------------------------
(defclass types::CLIPSFunctionBuilder
  (is-a FunctionBuilder)
  (multislot data-objects (visibility public))
  (multislot variables (visibility public))
  (multislot parsing-entries (visibility public))
  (slot count))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIArgumentBuilder
  (is-a Object)
  (slot clips-type (type SYMBOL) (visibility public))
  (slot gl-type (type SYMBOL) (visibility public))
  (slot clips-function-name (type SYMBOL) (visibility public))
  (slot index (type INTEGER) (range 1 ?VARIABLE) (visibility public))
  (slot argument-name-base (type SYMBOL STRING) (visibility public))
  (slot data-object-argument-name (type SYMBOL STRING) (visibility public))
  (slot variable-argument-name (type SYMBOL STRING) (visibility public))
  (slot variable-declaration (type STRING) (visibility public))
  (slot data-object-declaration (type STRING) (visibility public))
  (message-handler get-type-check-code)
  (message-handler get-conversion-code))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIArgumentBuilder get-type-check-code ()
						  (return (format nil
												"if(EnvArgTypeCheck(theEnv,%s,%d,%s,&%s) == -1) { return; }"
												?self:clips-function-name
												?self:index
												?self:clips-type
												?self:data-object-argument-name)))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIArgumentBuilder get-conversion-code ()
						  (return (format nil "%s = %s(%s);"
												?self:variable-argument-name
												(get-conversion-function
												  (flatten-type ?self:clips-type))
												?self:data-object-argument-name)))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIMultifieldArgumentBuilder
  (is-a CLIPSGLAPIArgumentBuilder)
  (slot multifield-length-variable-declaration (visibility public))
  (slot multifield-length-variable-name (visibility public))
  (slot multifield-pointer-argument-name (visibility public))
  (slot multifield-pointer-declaration (visibility public))
  (message-handler get-type-check-code)
  (message-handler get-conversion-code))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIMultifieldArgumentBuilder
						  get-type-check-code primary ()
						  (return (format nil
												"if(EnvArgTypeCheck(theEnv,%s,%d,MULTIFIELD,&%s) == -1) { return; }"
												?self:clips-function-name
												?self:index
												?self:data-object-argument-name)))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIMultifieldArgumentBuilder
						  get-conversion-code ()
						  (return (format nil "%s%n%s%n%s%n%s%n"
												;GetLength
												(format nil "%s = GetDOLength(%s);"
														  ?self:multifield-length-variable-name
														  ?self:data-object-argument-name)
												;GetValue
												(format nil "%s = GetValue(%s);"
														  ?self:multifield-pointer-argument-name
														  ?self:data-object-argument-name)
												;Generate malloc
												(format nil "%s = (%s*)calloc(%s,sizeof(%s));"
														  ?self:variable-argument-name
														  ?self:gl-type
														  ?self:multifield-length-variable-name
														  ?self:gl-type)
												;Conversion
												(format nil "%s%n%s%n%s%n"
														  (format nil "int i, end;%nend = GetDOEnd(%s);"
																	 ?self:data-object-argument-name)
														  (format nil "for(i = GetDOBegin(%s); i<=end; i++) {",
																	 ?self:data-object-argument-name)
														  ;TODO: Continue
														  ))))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIFixedSizeMultifieldArgumentBuilder
  (is-a CLIPSGLAPIMultifieldArgumentBuilder)
  (slot multifield-size (visibility public)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; GLAPIConversionTypes.clp - Functions for the glapi conversion expert
; system
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type (visibility public))
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
						  ()
						  (return (format nil "%s %s %s %s"
												(if ?self:is-constant then "const" else "")
												?self:argument-type
												(if ?self:is-pointer then "*" else "")
												?self:argument-name)))
;------------------------------------------------------------------------------
(defclass types::GLAPIFixedArrayArgument
  "Refers to fixed size arrays"
  (is-a GLAPIArgument)
  (slot array-size)
  (message-handler reconstitute around))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFixedArrayArgument reconstitute around
						  ()
						  (return (format nil "%s[%s]"
												(call-next-handler)
												(str-cat ?self:array-size))))
;------------------------------------------------------------------------------
(defclass types::FunctionBuilder
  "Builds C functions"
  (is-a Object)
  (multislot contents))
;------------------------------------------------------------------------------
(defclass types::CLIPSFunctionBuilder
  (is-a FunctionBuilder)
  (multislot data-objects)
  (multislot variables)
  (multislot parsing-entries)
  (slot count))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIArgumentBuilder
  (is-a Object)
  (slot clips-type (type SYMBOL))
  (slot gl-type (type SYMBOL))
  (slot clips-function-name (type SYMBOL))
  (slot index (type INTEGER) (range 1 ?VARIABLE))
  (slot argument-name-base (type SYMBOL STRING))
  (slot data-object-argument-name (type SYMBOL STRING))
  (slot variable-argument-name (type SYMBOL STRING))
  (slot variable-declaration (type STRING))
  (slot data-object-declaration (type STRING))
  (message-handler get-type-check-code)
  (message-handler get-conversion-code))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIArgumentBuilder get-type-check-code ()
						  (return (format nil
												"if(EnvArgTypeCheck(theEnv,%s,%d,%s,&%s) == -1) { return; }"
												?self:clips-function-name
												?self:index
												?self:clips-type
												?self:data-object-argument-name)))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIArgumentBuilder get-conversion-code ()
						  (return (format nil "%s = %s(%s);"
												?self:variable-argument-name
												(get-conversion-function
												  (flatten-type ?self:clips-type))
												?self:data-object-argument-name)))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIMultifieldArgumentBuilder
  (is-a CLIPSGLAPIArgumentBuilder)
  (slot multifield-length-variable-declaration)
  (slot multifield-length-variable-name)
  (slot multifield-pointer-argument-name)
  (slot multifield-pointer-declaration)
  (message-handler get-type-check-code)
  (message-handler get-conversion-code))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIMultifieldArgumentBuilder
						  get-type-check-code primary ()
						  (return (format nil
												"if(EnvArgTypeCheck(theEnv,%s,%d,MULTIFIELD,&%s) == -1) { return; }"
												?self:clips-function-name
												?self:index
												?self:data-object-argument-name)))
;------------------------------------------------------------------------------
(defmessage-handler types::CLIPSGLAPIMultifieldArgumentBuilder
						  get-conversion-code ()
						  (return (format nil "%s%n%s%n%s%n%s%n"
												;GetLength
												(format nil "%s = GetDOLength(%s);"
														  ?self:multifield-length-variable-name
														  ?self:data-object-argument-name)
												;GetValue
												(format nil "%s = GetValue(%s);"
														  ?self:multifield-pointer-argument-name
														  ?self:data-object-argument-name)
												;Generate malloc
												(format nil "%s = (%s*)calloc(%s,sizeof(%s));"
														  ?self:variable-argument-name
														  ?self:gl-type
														  ?self:multifield-length-variable-name
														  ?self:gl-type)
												;Conversion
												(format nil "%s%n%s%n%s%n"
														  (format nil "int i, end;%nend = GetDOEnd(%s);"
																	 ?self:data-object-argument-name)
														  (format nil "for(i = GetDOBegin(%s); i<=end; i++) {",
																	 ?self:data-object-argument-name)
														  ;TODO: Continue
														  ))))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIFixedSizeMultifieldArgumentBuilder
  (is-a CLIPSGLAPIMultifieldArgumentBuilder)
  (slot multifield-size))
;------------------------------------------------------------------------------


Modified the PathConstruction logic to path all regions.

This includes loops.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PathConstruction.clp - Contains rules devoted to starting the construction of
; a given path through a given region. Rewritten to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths::initialize-path-construction-region
			(declare (salience 3))
			;?fct <- (compute paths in region ?id)
			?r0 <- (object (is-a Region) (id ?id) (Entrances $? ?a $?)
								(contents $? ?z $?))
			(object (is-a Region) (id ?z) (parent ?id) (Entrances $? ?a $?))
			(object (is-a BasicBlock) (id ?a) (parent ?n&~?id))
			=>
			;(retract ?fct)
			(make-instance of Path (parent ?n) (values ?z)))
;------------------------------------------------------------------------------
(defrule paths::initialize-path-construction-basicblock
			(declare (salience 3))
			;?fct <- (compute paths in region ?id)
			?r0 <- (object (is-a Region) (id ?id) (Entrances $? ?a $?)
								(contents $? ?z $?))
			(object (is-a BasicBlock) (id ?a) (parent ?n))
			=>
			;(retract ?fct)
			(make-instance of Path (parent ?n) (values ?a)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PathConstruction.clp - Contains rules devoted to starting the construction of
; a given path through a given region. Rewritten to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths::initialize-path-construction-region
			(declare (salience 3))
			?fct <- (compute paths in region ?id)
			?r0 <- (object (is-a Region) (id ?id) (Entrances $? ?a $?)
								(contents $? ?z $?))
			(object (is-a Region) (id ?z) (parent ?id) (Entrances $? ?a $?))
			(object (is-a BasicBlock) (id ?a) (parent ?n&~?id))
			=>
			(retract ?fct)
			(make-instance of Path (parent ?n) (values ?z)))
;------------------------------------------------------------------------------
(defrule paths::initialize-path-construction-basicblock
			(declare (salience 3))
			?fct <- (compute paths in region ?id)
			?r0 <- (object (is-a Region) (id ?id) (Entrances $? ?a $?)
								(contents $? ?z $?))
			(object (is-a BasicBlock) (id ?a) (parent ?n))
			=>
			(retract ?fct)
			(make-instance of Path (parent ?n) (values ?a)))
;------------------------------------------------------------------------------


Modified ConstantConversionFunctions.clp to put ; at the end of conditionals

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; ConstantConversionFunctions.clp - Defines the functions specific to the
; constant conversion expert system
;------------------------------------------------------------------------------
(deffunction grouping-update::retrieve-element (?s)
             (nth 1 (send (instance-address * (symbol-to-instance-name ?s))
                          get-contents)))
;------------------------------------------------------------------------------
(deffunction grouping-update::to-conditional-field (?symbol ?if)
             (bind ?str (str-cat (retrieve-element ?symbol)))
             (create$ (format nil "%s(strcmp(input, \"%s\") == 0) {"
                              (if ?if then "if" else "} else if")
                              (sub-string (+ (str-index "_" ?str) 1)
                                          (str-length ?str) ?str))
                      (format nil "return %s;" ?str)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; ConstantConversionFunctions.clp - Defines the functions specific to the
; constant conversion expert system
;------------------------------------------------------------------------------
(deffunction grouping-update::retrieve-element (?s)
             (nth 1 (send (instance-address * (symbol-to-instance-name ?s))
                          get-contents)))
;------------------------------------------------------------------------------
(deffunction grouping-update::to-conditional-field (?symbol ?if)
             (bind ?str (str-cat (retrieve-element ?symbol)))
             (create$ (format nil "%s(strcmp(input, \"%s\") == 0) {"
                              (if ?if then "if" else "} else if")
                              (sub-string (+ (str-index "_" ?str) 1)
                                          (str-length ?str) ?str))
                      (format nil "return %s" ?str)))
;------------------------------------------------------------------------------