GLAPIConversion.clp: Added a line about fixed size blocks

;------------------------------------------------------------------------------
;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))
;------------------------------------------------------------------------------
(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))))
;------------------------------------------------------------------------------
; build-groups module
;------------------------------------------------------------------------------
(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
					  (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
			(retract ?msg)
			(make-instance of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(deffunction build-groups::count-commas
				 "Iterates through a multifield and counts the number of commas"
				 (?list)
				 (bind ?count 0)
				 (progn$ (?e ?list)
							(if (or (eq ?e ",")
									  (eq ?e ,)) then
							  (bind ?count (+ 1 ?count))))
				 (return ?count))
;------------------------------------------------------------------------------
(defrule build-groups::concatentate-length
			"Adds a range to the target argument set"
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ?o => $?contents))
			=>
			(modify ?fct (action diverge-arguments)
					  (arguments ?o 0 (count-commas $?contents) =>
									 $?contents)))
;------------------------------------------------------------------------------
(defrule build-groups::diverge-arguments
			"Splits the set of arguments into two separate facts"
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?start ?finish => $?a "," $?b))
			(test (neq ?start ?finish))
			=>
			(bind ?cca (count-commas $?a))
			(bind ?starta ?start)
			(bind ?enda (+ ?starta ?cca))
			;from start to end
			(bind ?startb (+ 1 ?enda))
			;we use finish since it's the upper bound on this argument set
			(bind ?endb ?finish)
			(modify ?fct (arguments ?o ?starta ?enda => $?a))
			(duplicate ?fct (arguments ?o ?startb ?endb => $?b)))
;------------------------------------------------------------------------------
(defrule build-groups::generate-build-argument-statement
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?pos ?pos => $?conditions))
			=>
			(modify ?fct (action build-argument)
					  (arguments ?o ?pos => $?conditions)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-fixed-array
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?field "[" ?size "]"))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?field))
			(make-instance ?name of GLAPIFixedArrayArgument
								(parent ?o)
								(array-size ?size)
								(index ?ind)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-generic
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?input))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?input))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index ?ind)))
;------------------------------------------------------------------------------
; grouping-update module
;------------------------------------------------------------------------------
(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))
			=>
			(modify ?fct (arguments ?o =>))

			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o =>))
			(object (is-a GLAPIArgument)
					  (id ?o)
					  (parent ?p))
			=>
			(modify ?fct (action make-function-builder)
					  (arguments ?p)))
;------------------------------------------------------------------------------
(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))
;------------------------------------------------------------------------------
; So, what do we need to do to construct a single function
; 0) Generate the registration entry for the target builder
; 1) Generate the function builder (done)
; 2) Define required arguments
; 3) Figure out type conversions
; 4) Define translation code for each argument
; 5) Generate code to call the target function with the given arguments
; 6) Assemble the function together
;------------------------------------------------------------------------------
; We use EnvDefineFunction in all cases of registration
;
; For conversion of pointers, we take in a multifield from clips and convert
; that to a corresponding pointer. We can also use macros or a function to
; do the conversion, that would make this whole process a lot easier.
;
; While it goes against the standard practices of C, I am going to have this
; conversion function perform the malloc and return the pointer. It is up to
; the function that called the conversion function to clean up the pointer once
; finished.
;
; However, continually calling malloc and free is costly. We can allocate a
; pointer ahead of time and continually resize it as necessary. We could also
; define a huge block of memory and then slice it accordingly.
;
; I know this for certain, this technique will go through many iterations
; before I arrive at a valid solution (most likely).
;
; The functions that take in a fixed size array are easy because I can allocate
; a static block ahead of time that I can read and write from.
;------------------------------------------------------------------------------
(defrule grouping-update::make-function-builder
			?fct <- (message (to grouping-update)
								  (action make-function-builder)
								  (arguments ?p))
			=>
			(modify ?fct (action build-function)
					  (arguments ?p -1))
			(make-instance of CLIPSFunctionBuilder
								(parent ?p)))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-header
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p -1))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p))
			(object (is-a GLAPIFunction)
					  (id ?p)
					  (return-type ?ret)
					  (clips-function-name ?cfn))
			=>
			(modify ?fct (arguments ?p 0))
			(modify-instance ?obj (contents
											(format nil "extern %s %s(void* theEnv) {"
													  ?ret ?cfn))))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-add-argument
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			?arg <- (object (is-a GLAPIArgument)
								 (parent ?p)
								 (index ?index)
								 (id ?argID))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p)
								 (parsing-entries $?pe)
								 (contents $?contents))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(modify-instance ?obj
								  (contents $?contents
												(format nil "//code to handle %s"
														  (send ?arg reconstitute)))))
;------------------------------------------------------------------------------
(defrule grouping-update::close-function
			(declare (salience -1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			(not (exists (object (is-a GLAPIArgument)
										(parent ?p)
										(index ?index))))
			?f <- (object (is-a CLIPSFunctionBuilder)
							  (parent ?p)
							  (contents $?contents))
			=>
			(modify ?fct (action print-function)
					  (arguments ?p))
			(modify-instance ?f (contents $?contents "}")
								  (count ?index)))
;------------------------------------------------------------------------------
(defrule grouping-update::print-built-function
			?fct <- (message (to grouping-update)
								  (action print-function)
								  (arguments ?p))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?c))
			=>
			(progn$ (?line ?c)
					  (printout t ?line crlf))
			(printout t crlf crlf)
			(retract ?fct)
			(unmake-instance ?f))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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))
;------------------------------------------------------------------------------
(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))))
;------------------------------------------------------------------------------
; build-groups module
;------------------------------------------------------------------------------
(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
					  (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
			(retract ?msg)
			(make-instance of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(deffunction build-groups::count-commas
				 "Iterates through a multifield and counts the number of commas"
				 (?list)
				 (bind ?count 0)
				 (progn$ (?e ?list)
							(if (or (eq ?e ",")
									  (eq ?e ,)) then
							  (bind ?count (+ 1 ?count))))
				 (return ?count))
;------------------------------------------------------------------------------
(defrule build-groups::concatentate-length
			"Adds a range to the target argument set"
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ?o => $?contents))
			=>
			(modify ?fct (action diverge-arguments)
					  (arguments ?o 0 (count-commas $?contents) =>
									 $?contents)))
;------------------------------------------------------------------------------
(defrule build-groups::diverge-arguments
			"Splits the set of arguments into two separate facts"
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?start ?finish => $?a "," $?b))
			(test (neq ?start ?finish))
			=>
			(bind ?cca (count-commas $?a))
			(bind ?starta ?start)
			(bind ?enda (+ ?starta ?cca))
			;from start to end
			(bind ?startb (+ 1 ?enda))
			;we use finish since it's the upper bound on this argument set
			(bind ?endb ?finish)
			(modify ?fct (arguments ?o ?starta ?enda => $?a))
			(duplicate ?fct (arguments ?o ?startb ?endb => $?b)))
;------------------------------------------------------------------------------
(defrule build-groups::generate-build-argument-statement
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?pos ?pos => $?conditions))
			=>
			(modify ?fct (action build-argument)
					  (arguments ?o ?pos => $?conditions)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-fixed-array
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?field "[" ?size "]"))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?field))
			(make-instance ?name of GLAPIFixedArrayArgument
								(parent ?o)
								(array-size ?size)
								(index ?ind)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-generic
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?input))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?input))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index ?ind)))
;------------------------------------------------------------------------------
; grouping-update module
;------------------------------------------------------------------------------
(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))
			=>
			(modify ?fct (arguments ?o =>))

			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o =>))
			(object (is-a GLAPIArgument)
					  (id ?o)
					  (parent ?p))
			=>
			(modify ?fct (action make-function-builder)
					  (arguments ?p)))
;------------------------------------------------------------------------------
(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))
;------------------------------------------------------------------------------
; So, what do we need to do to construct a single function
; 0) Generate the registration entry for the target builder
; 1) Generate the function builder (done)
; 2) Define required arguments
; 3) Figure out type conversions
; 4) Define translation code for each argument
; 5) Generate code to call the target function with the given arguments
; 6) Assemble the function together
;------------------------------------------------------------------------------
; We use EnvDefineFunction in all cases of registration
;
; For conversion of pointers, we take in a multifield from clips and convert
; that to a corresponding pointer. We can also use macros or a function to
; do the conversion, that would make this whole process a lot easier.
;
; While it goes against the standard practices of C, I am going to have this
; conversion function perform the malloc and return the pointer. It is up to
; the function that called the conversion function to clean up the pointer once
; finished.
;
; However, continually calling malloc and free is costly. We can allocate a
; pointer ahead of time and continually resize it as necessary. We could also
; define a huge block of memory and then slice it accordingly.
;
; I know this for certain, this technique will go through many iterations
; before I arrive at a valid solution (most likely).
;------------------------------------------------------------------------------
(defrule grouping-update::make-function-builder
			?fct <- (message (to grouping-update)
								  (action make-function-builder)
								  (arguments ?p))
			=>
			(modify ?fct (action build-function)
					  (arguments ?p -1))
			(make-instance of CLIPSFunctionBuilder
								(parent ?p)))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-header
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p -1))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p))
			(object (is-a GLAPIFunction)
					  (id ?p)
					  (return-type ?ret)
					  (clips-function-name ?cfn))
			=>
			(modify ?fct (arguments ?p 0))
			(modify-instance ?obj (contents
											(format nil "extern %s %s(void* theEnv) {"
													  ?ret ?cfn))))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-add-argument
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			?arg <- (object (is-a GLAPIArgument)
								 (parent ?p)
								 (index ?index)
								 (id ?argID))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p)
								 (parsing-entries $?pe)
								 (contents $?contents))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(modify-instance ?obj
								  (contents $?contents
												(format nil "//code to handle %s"
														  (send ?arg reconstitute)))))
;------------------------------------------------------------------------------
(defrule grouping-update::close-function
			(declare (salience -1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			(not (exists (object (is-a GLAPIArgument)
										(parent ?p)
										(index ?index))))
			?f <- (object (is-a CLIPSFunctionBuilder)
							  (parent ?p)
							  (contents $?contents))
			=>
			(modify ?fct (action print-function)
					  (arguments ?p))
			(modify-instance ?f (contents $?contents "}")
								  (count ?index)))
;------------------------------------------------------------------------------
(defrule grouping-update::print-built-function
			?fct <- (message (to grouping-update)
								  (action print-function)
								  (arguments ?p))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?c))
			=>
			(progn$ (?line ?c)
					  (printout t ?line crlf))
			(printout t crlf crlf)
			(retract ?fct)
			(unmake-instance ?f))
;------------------------------------------------------------------------------


Fixed a bug in pre-init where get-Contents was being called on a wavefront

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::generate-wavefront-object
         (declare (salience 3))
         ?msg <- (message (to wavefront-scheduling)
                          (action can-wavefront-schedule)
                          (arguments ?p))
         (not (exists (object (is-a Wavefront)
                              (parent ?p))))
         =>
         (retract ?msg)
         (make-instance of Wavefront
                        (parent ?p)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::retract-wavefront-creation-action
         (declare (salience 3))
         ?msg <- (message (to wavefront-scheduling)
                          (action can-wavefront-schedule)
                          (arguments ?p))
         (exists (object (is-a Wavefront)
                         (parent ?p)))
         =>
         (retract ?msg))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::assert-add-block-to-wavefront
         (declare (salience 2))
         (object (is-a Wavefront)
                 (parent ?r))
         (object (is-a Region)
                 (id ?r)
                 (Entrances $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e)
                 (parent ?r))
         =>
         (assert (Add ?e to wavefront for ?r)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::assert-add-region-to-wavefront
         (declare (salience 2))
         (object (is-a Wavefront)
                 (parent ?r))
         (object (is-a Region)
                 (id ?r)
                 (Entrances $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e)
                 (parent ~?r))
         (object (is-a Region)
                 (parent ?r)
                 (Entrances $? ?e $?)
                 (id ?q))
         =>
         (assert (Add ?q to wavefront for ?r)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::convert-single-single=>multi
         (declare (salience 1))
         ?f0 <- (Add ?v0 to wavefront for ?r)
         ?f1 <- (Add ?v1&~?v0 to wavefront for ?r)
         =>
         (retract ?f0 ?f1)
         (assert (In wavefront ?r add ?v0 ?v1)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::convert-multi-multi=>multi
         (declare (salience 1))
         ?f0 <- (In wavefront ?r add $?a)
         ?f1 <- (In wavefront ?r add $?b)
         (test (neq ?f0 ?f1))
         =>
         (retract ?f0 ?f1)
         (assert (In wavefront ?r add $?a $?b)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::convert-single=>multi
         (declare (salience 1))
         ?f0 <- (Add ?v0 to wavefront for ?r)
         =>
         (retract ?f0)
         (assert (In wavefront ?r add ?v0)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::construct-wavefront-for-region
         (declare (salience -1))
         ?f <- (In wavefront ?r add $?w)
         ?wave <- (object (is-a Wavefront)
                          (parent ?r))
         =>
         (retract ?f)
         (modify-instance ?wave (values $?w)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::generate-wavefront-object
         (declare (salience 3))
         ?msg <- (message (to wavefront-scheduling)
                          (action can-wavefront-schedule)
                          (arguments ?p))
         (not (exists (object (is-a Wavefront)
                              (parent ?p))))
         =>
         (retract ?msg)
         (make-instance of Wavefront
                        (parent ?p)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::retract-wavefront-creation-action
         (declare (salience 3))
         ?msg <- (message (to wavefront-scheduling)
                          (action can-wavefront-schedule)
                          (arguments ?p))
         (exists (object (is-a Wavefront)
                         (parent ?p)))
         =>
         (retract ?msg))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::assert-add-block-to-wavefront
         (declare (salience 2))
         (object (is-a Wavefront)
                 (parent ?r))
         (object (is-a Region)
                 (id ?r)
                 (Entrances $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e)
                 (parent ?r))
         =>
         (assert (Add ?e to wavefront for ?r)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::assert-add-region-to-wavefront
         (declare (salience 2))
         (object (is-a Wavefront)
                 (parent ?r))
         (object (is-a Region)
                 (id ?r)
                 (Entrances $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e)
                 (parent ~?r))
         (object (is-a Region)
                 (parent ?r)
                 (Entrances $? ?e $?)
                 (id ?q))
         =>
         (assert (Add ?q to wavefront for ?r)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::convert-single-single=>multi
         (declare (salience 1))
         ?f0 <- (Add ?v0 to wavefront for ?r)
         ?f1 <- (Add ?v1&~?v0 to wavefront for ?r)
         =>
         (retract ?f0 ?f1)
         (assert (In wavefront ?r add ?v0 ?v1)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::convert-multi-multi=>multi
         (declare (salience 1))
         ?f0 <- (In wavefront ?r add $?a)
         ?f1 <- (In wavefront ?r add $?b)
         (test (neq ?f0 ?f1))
         =>
         (retract ?f0 ?f1)
         (assert (In wavefront ?r add $?a $?b)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::convert-single=>multi
         (declare (salience 1))
         ?f0 <- (Add ?v0 to wavefront for ?r)
         =>
         (retract ?f0)
         (assert (In wavefront ?r add ?v0)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pre-init::construct-wavefront-for-region
         (declare (salience -1))
         ?f <- (In wavefront ?r add $?w)
         ?wave <- (object (is-a Wavefront)
                          (parent ?r))
         =>
         (retract ?f)
         (modify-instance ?wave (contents $?w)))
;------------------------------------------------------------------------------


Cleaned up logic/area.clp

Cleaned up logic/area.clp

(load* /lib/core.clp)
(load* /lib/chicanery.clp)
(defgeneric setup-background)
(deftemplate pen-size
             (slot min
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 1))
             (slot max
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 128))
             (slot current
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 1)))

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

(definstances elements
              (menu1 of menu
                     (menu-entries cut copy paste))
              (menu2 of menu
                     (menu-entries eat sleep drink))
              (region0 of rectangle
                       (x 0)
                       (y 0)
                       (bx 64)
                       (by 20))
              (point0 of point
                      (x 0)
                      (y 32))
              (drawing-field of rectangle
                             (x 4)
                             (y 25)
                             (bx 1020)
                             (by 1020))
              (drawing-field-border of rectangle
                                    (x 0)
                                    (y 21)
                                    (bx 1024)
                                    (by 1024))
              (scratch-rect of rectangle
                            (x 0)
                            (y 0)
                            (bx 0)
                            (by 0))
              (text of image
                    (rectangle [region0])
                    (replicate TRUE)
                    (color (get-standard-color black)))
              (inset-rect0 of image
                           (rectangle [drawing-field-border])
                           (replicate TRUE)
                           (color (get-standard-color black)))
              (field0 of image
                      (rectangle [drawing-field])
                      (replicate TRUE)
                      (color (get-standard-color white)))
              (button-background of image
                                 (rectangle [region0])
                                 (replicate TRUE)
                                 (color (get-standard-color paleyellow)))
              (pixel-image of image
                           (rectangle [pixel])
                           (replicate TRUE)
                           (color (get-standard-color black))))

(deffacts query-operation
          (query input)
          (pen-size (min 1)
                    (max 128)
                    (current 1)))
(defmethod setup-background
  ()
  (screen/draw [drawing-field-border] [inset-rect0] [ZP])
  (screen/draw [drawing-field] [field0] [ZP])
  (screen/draw [region0] [button-background] [ZP])
  (screen/draw-text [ZP] [text] [ZP] "File")
  (screen/flush 1))

(defrule query-input
         ?f <- (query input)
         =>
         (retract ?f)
         (send [mouse] query)
         (send [keyboard] query)
         (assert (check mouse)
                 (check keyboard)))

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

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

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

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

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

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

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

(defrule process-keyboard-inputs:down
         (declare (salience 1))
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys DOWN))
         ?pen <- (pen-size (min ?min)
                           (current ?factor))
         =>
         (if (> ?factor ?min) then
           (modify ?pen (current (- ?factor 1))))
         (retract ?f)
         (assert (query keyboard)))

(defrule process-keyboard-inputs
         ?f <- (check keyboard)
         (object (is-a keyboard)
                 (name [keyboard])
                 (keys ?b&~NIL))
         =>
         (retract ?f)
         (printout t "Pressed " ?b crlf)
         (assert (query keyboard)))

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

(batch* /lib/reset-run-exit.clp)

(load* /lib/core.clp)
(load* /lib/chicanery.clp)

(deftemplate pen-size
             (slot min
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 1))
             (slot max
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 128))
             (slot current
                   (type INTEGER)
                   (range 1 ?VARIABLE)
                   (default 1)))

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

(definstances elements
              (menu1 of menu (menu-entries cut copy paste))
              (menu2 of menu (menu-entries eat sleep drink))
              (region0 of rectangle (x 0) (y 0) (bx 128) (by 32))
              (point0 of point (x 0) (y 32))
              (drawing-field of rectangle (x 4) (y 37) (bx 1020) (by 1020))
              (drawing-field-border of rectangle (x 0) (y 33) (bx 1024) (by 1024))
              (scratch-rect of rectangle (x 0) (y 0) (bx 0) (by 0))
              (text of image (rectangle [region0])
                    (replicate TRUE)
                    (color (get-standard-color black)))
              (inset-rect0 of image (rectangle [drawing-field-border])
                           (replicate TRUE)
                           (color (get-standard-color black)))
              (field0 of image (rectangle [drawing-field])
                      (replicate TRUE)
                      (color (get-standard-color white)))
              (button-background of image (rectangle [region0])
                                 (replicate TRUE)
                                 (color (get-standard-color paleyellow)))
              (pixel-image of image (rectangle [pixel])
                           (replicate TRUE)
                           (color (get-standard-color black))))

(deffacts query-operation
          (query input)
          (pen-size (min 1)
                    (max 128)
                    (current 1)))

(defrule setup-background
         (declare (salience 10000))
         ?f <- (setup background)
         =>
         (retract ?f)
         (screen/draw [drawing-field-border] [inset-rect0] [ZP])
         (screen/draw [drawing-field] [field0] [ZP])
         (screen/draw [region0] [button-background] [ZP])
         (screen/draw-text [ZP] [text] [ZP] "File")
         (screen/flush 1))

(defrule query-input
         ?f <- (query input)
         =>
         (retract ?f)
         (send [mouse] query)
         (send [keyboard] query)
         (assert (check mouse)
                 (check keyboard)))

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

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

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

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

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

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

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

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

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

(batch* /lib/reset-run-exit.clp)


Rewrote the PassRegistry to use the new pass layout

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; PassRegistry.clp - Contains the listing of the standard set of passes.
;------------------------------------------------------------------------------
; NOTE: If you want to define your own place to load passes from then remember
; that it is up to you to load it initially.
;------------------------------------------------------------------------------

;This is part of the MAIN module
(definstances PersistentPassRegistry
 ([paths] of Pass
  (entry-point "passes/path/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))

 ;([pass-valid-paths] of Pass
 ; (entry "passes/path/valid-only/PassHeader.clp")
 ; (pass-name "valid-paths")
 ; (pass-description "Generate the set of paths through user-defined valid regions in a function")
 ; (target Function))
 ;([pass-paths] of Pass
 ; (entry "passes/path/all-paths/PassHeader.clp")
 ; (pass-name "paths")
 ; (pass-description "Generate the set of all paths through all regions in a function")
 ; (target Function))

)

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; PassRegistry.clp - Contains the listing of the standard set of passes.
;------------------------------------------------------------------------------
; NOTE: If you want to define your own place to load passes from then remember
; that it is up to you to load it initially.
;------------------------------------------------------------------------------

;This is part of the MAIN module
(definstance PersistentPassRegistry
 ([pass-valid-paths] of Pass
  (entry "passes/path/valid-only/PassHeader.clp")
  (pass-name "valid-paths")
  (pass-description "Generate the set of paths through user-defined valid regions in a function")
  (target Function))
 ([pass-paths] of Pass
  (entry "passes/path/all-paths/PassHeader.clp")
  (pass-name "paths")
  (pass-description "Generate the set of all paths through all regions in a function")
  (target Function))

)


Added extensions.clp.

Added extensions.clp.

This contains methods that extend off of the native methods provided by
the electron runtime

;------------------------------------------------------------------------------
;electron-filesystem
;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 electron-filesystem 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.
;------------------------------------------------------------------------------
; extensions.clp - extends native functions to make them easier to use
;
;------------------------------------------------------------------------------
(defmethod merge
  ($?atoms INTEGER)
  (merge ?atoms))
;------------------------------------------------------------------------------
(defmethod binary-or
  ((?values MULTIFIELD INTEGER (> (length$ ?values) 4)))
  (bind ?number (nth$ 1 (first$ ?values)))
  (progn$ (?value (rest$ ?values))
          (bind ?number (binary-or ?number ?value)))
  (return ?number))

(defmethod binary-or
  (($?values INTEGER (> (length$ ?values) 4)))
  (binary-or ?values))

(defmethod binary-or
  ((?a INTEGER)
   (?b INTEGER)
   (?c INTEGER))
  (binary-or ?a (binary-or ?b ?c)))

(defmethod binary-or
  ((?a INTEGER)
   (?b INTEGER)
   (?c INTEGER)
   (?d INTEGER))
  (binary-or ?a (binary-or ?b (binary-or ?c ?d))))

;------------------------------------------------------------------------------

(defmethod binary-and
  ((?values MULTIFIELD INTEGER (> (length$ ?values) 4)))
  (bind ?number (nth$ 1 (first$ ?values)))
  (progn$ (?value (rest$ ?values))
          (bind ?number (binary-and ?number ?value)))
  (return ?number))

(defmethod binary-and
  (($?values INTEGER (> (length$ ?values) 4)))
  (binary-and ?values))

(defmethod binary-and
  ((?a INTEGER)
   (?b INTEGER)
   (?c INTEGER))
  (binary-and ?a (binary-and ?b ?c)))

(defmethod binary-and
  ((?a INTEGER)
   (?b INTEGER)
   (?c INTEGER)
   (?d INTEGER))
  (binary-and ?a (binary-and ?b (binary-and ?c ?d))))
;------------------------------------------------------------------------------

(defmethod binary-xor
  ((?values MULTIFIELD INTEGER (> (length$ ?values) 4)))
  (bind ?number (nth$ 1 (first$ ?values)))
  (progn$ (?value (rest$ ?values))
          (bind ?number (binary-xor ?number ?value)))
  (return ?number))

(defmethod binary-xor
  (($?values INTEGER (> (length$ ?values) 4)))
  (binary-xor ?values))

(defmethod binary-xor
  ((?a INTEGER)
   (?b INTEGER)
   (?c INTEGER))
  (binary-xor ?a (binary-xor ?b ?c)))

(defmethod binary-xor
  ((?a INTEGER)
   (?b INTEGER)
   (?c INTEGER)
   (?d INTEGER))
  (binary-xor ?a (binary-xor ?b (binary-xor ?c ?d))))

error: pathspec 'sys/core/extensions.clp' did not match any file(s) known to git