Fixed slot names in WavefrontInitialization.clp

;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-init::build-path-aggregate-for-block
         (declare (salience 100))
         (object (is-a Wavefront)
                 (parent ?r)
                 (values $? ?e $?))
         (object (is-a BasicBlock)
                 (id ?e)
                 (contents $?c))
         =>
         (assert (message (to wavefront-schedule)
                          (action propagate-aggregates)
                          (arguments ?e)))
         (make-instance of PathAggregate (parent ?e)
                        (OriginalStopIndex (- (length$ $?c) 1))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-init::build-path-aggregate-for-region
         (declare (salience 100))
         (object (is-a Wavefront)
                 (parent ?r)
                 (values $? ?e $?))
         (object (is-a Region)
                 (id ?e))
         =>
         (assert (message (to wavefront-schedule)
                          (action propagate-aggregates)
                          (arguments ?e)))
         (make-instance of PathAggregate (parent ?e)))
;------------------------------------------------------------------------------

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


Removed the extra pipeline push onto the focus stack

This is done automatically by the focus command itself.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PassHandler.clp - Contains the logic necessary to handle pass execution
;------------------------------------------------------------------------------
(defrule pipeline::build-pass-descriptor
         ?fct <- (message (to pipeline)
                          (action pass-description)
                          (arguments $?passes))
         =>
         (retract ?fct)
         (make-instance of pass-description (passes $?passes)))
;------------------------------------------------------------------------------
(defrule pipeline::next-pass
         ?obj <- (object (is-a pass-description)
                         (passes ?first $?rest))
         =>
         (modify-instance ?obj (passes $?rest))
         ;remove what is currently on the focus stack
         ;			(pop-focus)
         (assert (message (from pipeline)
                          (to ?first)
                          (action initial-fact)))
         (focus ?first))
;------------------------------------------------------------------------------
(defrule pipeline::terminate-pass
         ?obj <- (object (is-a pass-description)
                         (passes))
         =>
         (unmake-instance ?obj))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PassHandler.clp - Contains the logic necessary to handle pass execution
;------------------------------------------------------------------------------
(defrule pipeline::build-pass-descriptor
         ?fct <- (message (to pipeline)
                          (action pass-description)
                          (arguments $?passes))
         =>
         (retract ?fct)
         (make-instance of pass-description (passes $?passes)))
;------------------------------------------------------------------------------
(defrule pipeline::next-pass
         ?obj <- (object (is-a pass-description)
                         (passes ?first $?rest))
         =>
         (modify-instance ?obj (passes $?rest))
         ;remove what is currently on the focus stack
         ;			(pop-focus)
         (assert (message (from pipeline)
                          (to ?first)
                          (action initial-fact)))
         (focus ?first pipeline))
;------------------------------------------------------------------------------
(defrule pipeline::terminate-pass
         ?obj <- (object (is-a pass-description)
                         (passes))
         =>
         (unmake-instance ?obj))
;------------------------------------------------------------------------------


Changed PassDescriptor to pass-description in the terminate-pass rule

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PassHandler.clp - Contains the logic necessary to handle pass execution
;------------------------------------------------------------------------------
(defrule pipeline::build-pass-descriptor
			?fct <- (message (to pipeline)
								  (action pass-description)
								  (arguments $?passes))
			=>
			(retract ?fct)
			(make-instance of pass-description (passes $?passes)))
;------------------------------------------------------------------------------
(defrule pipeline::next-pass
			?obj <- (object (is-a pass-description)
								 (passes ?first $?rest))
			=>
			(modify-instance ?obj (passes $?rest))
			;remove what is currently on the focus stack
			(pop-focus)
			(assert (message (from pipeline)
								  (to ?first)
								  (action initial-fact)))
			(focus ?first pipeline))
;------------------------------------------------------------------------------
(defrule pipeline::terminate-pass
			?obj <- (object (is-a pass-description)
								 (passes))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PassHandler.clp - Contains the logic necessary to handle pass execution
;------------------------------------------------------------------------------
(defrule pipeline::build-pass-descriptor
			?fct <- (message (to pipeline)
								  (action pass-description)
								  (arguments $?passes))
			=>
			(retract ?fct)
			(make-instance of pass-description (passes $?passes)))
;------------------------------------------------------------------------------
(defrule pipeline::next-pass
			?obj <- (object (is-a pass-description)
								 (passes ?first $?rest))
			=>
			(modify-instance ?obj (passes $?rest))
			;remove what is currently on the focus stack
			(pop-focus)
			(assert (message (from pipeline)
								  (to ?first)
								  (action initial-fact)))
			(focus ?first pipeline))
;------------------------------------------------------------------------------
(defrule pipeline::terminate-pass
			?obj <- (object (is-a PassDescriptor)
								 (passes))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------


Create repro_template.clp

Create repro_template.clp

repro template
usage:
blastdb
db2 -tvf repro_template.clp | tee repro.out

!db2level ;   -- echo current db2 level
!db2set -r ;  -- reset all db2 registers

!db2set DB2_ROCM_DISABLE_FS_CHECK=TRUE;     -- set db2 register values
!db2set DB2_USE_FAST_SCATTERED_IO=OFF;
!db2set DB2_SYSTEM_RAM=1GB;

!db2set -all;     --echo all db2s regsiter values

!db2stop  ;
!db2start ;
create database ldrng_db ;
connect to ldrng_db ;

create long tablespace lng1 managed by database using (file 'tmp/lng1' 1000);
create tablespace reg1 managed by database using (file 'tmp/reg1' 10000);
create tablespace reg2 managed by database using (file 'tmp/reg2' 10000);
create tablespace inx1 managed by database using (file 'tmp/inx1' 30000);

create table TABLE130_9 ( a int , b double not null unique, c varchar(10) not null, d LONG VARCHAR) long in lng1 distribute by(b) organize by
dimensions(a,c) partition by range (a NULLS FIRST,b NULLS LAST) (part p0 starting (MINVALUE,MINVALUE) ending (9,MAXVALUE) in reg1, part p1 starting (10,0) ending (190000,MAXVALUE) in reg1, part p2 starting (200000,0) ending (500000,100000) in reg2);

create index indx1 on TABLE130_9 (a) not partitioned;
insert into TABLE130_9 values (1,2,'aa',NULL);

runstats on table TABLE130_9 with distribution and indexes all set profile only;

load from ldrng130_9.asc of ASC MODIFIED BY reclen= 1047 method L( 1 11, 13 34, 36 45, 47 1046) NULL INDICATORS ( 12, 35, 46, 1047) replace into TABLE130_9 statistics use profile;

select npages from sysstat.tables where tabname='TABLE130_9';

terminate;

error: pathspec 'repro_template.clp' did not match any file(s) known to git


GLAPIConversion.clp: Added classes for argument conversion

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Conversion table
;------------------------------------------------------------------------------
; float => all floating point types
; int => all integer types
; symbol => GLenum or GLboolean
; multifield => pointer type or fixed array
;------------------------------------------------------------------------------
(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))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(duplicate ?fct (action parse-entry)
						  (arguments ?p ?index => ?argID)))
;------------------------------------------------------------------------------
(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))
			=>
			(retract ?fct)
			(modify ?fct (action construct-function)
					  (arguments ?p -1))
			(modify-instance ?f (count ?index)))
;------------------------------------------------------------------------------
(defrule grouping-update::construct-function-entry
			?f <- (message (to grouping-update)
								(action construct-function)
								(arguments ?p -1))

			=>
			(modify ?f (argument ?p 0)))
;------------------------------------------------------------------------------
(defrule grouping-update::construct-function-argument-deferred
			?f <- (message (to grouping-update)
								(action construct-function)
								(arguments ?p ?index))
			?f1 <- (message (to grouping-update)
								 (action parse-entry)
								 (arguments ?p ?index => ?argID))
			?b <- (object (is-a CLIPSFunctionBuilder)
							  (parent ?p)
							  (data-objects $?do)
							  (variables $?vars)
							  (parsing-entries $?pe))
			=>
			;generate the name of the object for the target argument entry
			(bind ?name (gensym*))
			(modify ?f (arguments ?p (+ ?index 1)))
			;put name on each of the element sets.
			;We use that name and message passing to generate corresponding
			;entries in a macro-expand fashion
			(modify-instance ?b (data-objects $?do ?name)
								  (variables $?vars ?name)
								  (parsng-entries $?pe ?name))
			(modify ?f1 (action construct-entry)
					  (arguments ?argID => ?name)))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIArgumentBuilder
          (is-a Object)
			 (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))
			 (slot conversion-code (type STRING)))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIMultifieldArgumentBuilder
          (is-a CLIPSGLAPIArgumentBuilder)
			 (slot multifield-pointer-argument-name)
			 (slot multifield-pointer-declaration))
;------------------------------------------------------------------------------
(defclass types::CLIPSGLAPIFixedSizeMultifieldArgumentBuilder
          (is-a CLIPSGLAPIMultifieldArgumentBuilder)
			 (slot multifield-size))
;------------------------------------------------------------------------------
(defrule grouping-update::construct-function-argument-builder
         ?f <- (message (to grouping-update)
				            (action construct-entry)
								(arguments ?arg => ?name))
			      (object (is-a GLAPIArgument)
					        (id ?arg)
							  (index ?index)
							  (is-pointer FALSE))
			=>
			(make-instance ?name of CLIPSGLAPIArgumentBuilder
			 (parent ?arg)
			 (argument-name-base (sym-cat (format nil "arg%d" ?index))))
			(modify ?f (action make-variable-declaration))
			(duplicate ?f (action make-data-object-declaration))
			(duplicate ?f (action make-conversion-code)))
;------------------------------------------------------------------------------
(defrule grouping-update::construct-function-argument-builder-multifield
         ?f <- (message (to grouping-update)
				            (action construct-entry)
								(arguments ?arg => ?name))
			      (object (is-a GLAPIArgument)
					        (id ?arg)
							  (index ?index)
							  (is-pointer TRUE))
			=>
			(make-instance ?name of CLIPSGLAPIMultifieldArgumentBuilder
			 (parent ?arg)
			 (argument-name-base (sym-cat (format nil "arg%d" ?index))))
			(modify ?f (action make-variable-declaration))
			(duplicate ?f (action make-data-object-declaration))
			(duplicate ?f (action make-multifield-conversion-code))
			(duplicate ?f (action make-conversion-code)))
;------------------------------------------------------------------------------
(defrule grouping-update::construct-function-argument-builder-multifield-fixed
         (declare (salience 1))
         ?f <- (message (to grouping-update)
				            (action construct-entry)
								(arguments ?arg => ?name))
			      (object (is-a GLAPIFixedArrayArgument)
					        (id ?arg)
							  (index ?index)
							  (size ?size))
			=>
			(make-instance ?name of CLIPSGLAPIFixedMultifieldArgumentBuilder
			 (parent ?arg)
			 (multifield-size ?size)
			 (argument-name-base (sym-cat (format nil "arg%d" ?index))))
			(modify ?f (action make-variable-declaration))
			(duplicate ?f (action make-data-object-declaration))
			(duplicate ?f (action make-multifield-conversion-code))
			(duplicate ?f (action make-conversion-code)))
;------------------------------------------------------------------------------
(defrule grouping-update::construct-multifield-conversion-code
         ?f <- (message (to grouping-update)
				            (action make-multifield-conversion-code)
								(arguments ?arg => ?name))
			?o <- (object (is-a CLIPSGLAPI
;------------------------------------------------------------------------------
(defrule grouping-update::construct-data-object-declaration
         ?f <- (message (to grouping-update)
				            (action make-data-object-declaration)
								(arguments ?arg => ?name))
			?ab <- (object (is-a CLIPSGLAPIArgumentBuilder)
				            (id ?name)
								(argument-name-base ?anb))
			=>
			(modify ?f (action finished-data-object-declaration))
			(bind ?doArg (sym-cat (format nil "%s_DO" ?anb)))
			(modify-instance ?ab
			 (data-object-argument-name ?doArg)
			 (data-object-declaration (format nil "DATA_OBJECT %s;" ?doArg)))
;------------------------------------------------------------------------------
;------------------------------------------------------------------------------
; Printout results
;------------------------------------------------------------------------------
(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).
;
; 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.
;------------------------------------------------------------------------------
; Conversion table
;------------------------------------------------------------------------------
; float => all floating point types
; int => all integer types
; symbol => GLenum or GLboolean
; multifield => pointer type or fixed array
;------------------------------------------------------------------------------
(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))
;------------------------------------------------------------------------------


my last comment "only already bound variables" is of course wrong. but it works also with unbound variables. changes are only in the rulecompilertest.clp in the "nichtgelbpaar" rule:

- it demonstrates use of unbound variables in connected constraints
- it demonstrates the usage of test conditions again, because its nice to see, that they still work ;)

git-svn-id: 9643e93313b82f5e4da82d8413267a0daa4b5472@1343 2cd91b7d-3b21-0410-a5f4-f42db4f24360

(deftemplate wurst (slot name) (slot spitzname) (slot farbe)  (slot gewicht))
(deftemplate salat (slot name) (slot farbe) (slot dazupasst) (slot gewicht))
(deftemplate getraenk (slot name) (slot farbe) )
(deftemplate farbe (slot name) (slot red) (slot green) (slot blue) )

(assert (wurst (name "gruenspanwurst") (spitzname "gruebi") (farbe "hellgruen") (gewicht 1) ))
(assert (wurst (name "bratwurst")(spitzname "bratwosch")(farbe "weiss")(gewicht 100) ))
(assert (wurst (name "weisswurst")(spitzname "weisswurst")(farbe "weiss")(gewicht 200) ))
(assert (wurst (name "wienerwurst")(spitzname "wiener")(farbe "rot")(gewicht 300) ))
(assert (wurst (name "gemuesewurst")(spitzname "gemuesewurst")(farbe "gruen")(gewicht 400) ))
(assert (wurst (name "senfwurst") (spitzname "senfi") (farbe "gelb") (gewicht 200) ))
(assert (salat (name "kartoffelsalat")(farbe "weiss")(gewicht 220)(dazupasst "weisswurst") ))
(assert (salat (name "weissgurkensalat")(farbe "weiss")(dazupasst "spaghetti")(gewicht 320) ))
(assert (salat (name "gelbebohnensalat") (farbe "gelb") (dazupasst "knoblauchmarmelade") (gewicht 123) ))
(assert (salat (name "gruengurkensalat")(farbe "hellgruen")(dazupasst "spaghettisd")(gewicht 32320) ))
(assert (getraenk (name "wasser") (farbe "schwarz") ))
(assert (getraenk (name "cola") (farbe "schwarz")   ))
(assert (getraenk (name "kartoffelsalatdrink") (farbe "weiss") ))

(assert (farbe (name weiss) (red 1) (green 1) (blue 1)))
(assert (farbe (name schwarz) (red 0) (green 0) (blue 0)))
(assert (farbe (name rot) (red 1) (green 0) (blue 0)))
(assert (farbe (name gruen) (red 0) (green 1) (blue 0)))
(assert (farbe (name blau) (red 0) (green 0) (blue 1)))
(assert (farbe (name gelb) (red 1) (green 1) (blue 0)))
(assert (farbe (name hellgruen) (red 0.3) (green 1) (blue 0.3)))

(defrule nichtgelbpaar
	(wurst (farbe ?wurstfarbe) (name ?wurstname) )
	(salat (farbe ?salatfarbe) (name ?salatname) )
	(farbe (name ?wurstfarbe & ?salatfarbe & ~ gelb & ?farbe) (green ?gruen) (blue ?blau) )
	(farbe (name ?farbe) (red ?rot) )
	(test (eq (str-length ?farbe) 5) )
	=>
	(printout t "Ein Wurst/Salat Paar mit gleicher Farbe (bei der der Name die Länge 5 hat), die nicht Gelb ist, ist " ?wurstname "/" ?salatname " und hat die RGB Farbanteile " ?rot "," ?gruen "," ?blau "!" crlf)
)

(fire)

(defrule babaam
	(or
		(not (wurst (name "weisswurst") )  )
		(not (wurst (name "bratwurst") )  )
	)
	=>
	(printout t "es gibt entweder keine w oder keine b" crlf)
)

(fire)

(defrule vorschlag
 	(salat (name ?salatname) (dazupasst ?match))
 	(not
 		(wurst (name ?match))
  	)
  	(not
 		(wurst (gewicht 300))
  	)
  	=>
 	(printout t "man kann einen " ?salatname " essen." crlf)
)

(defrule tst
	(wurst (name ~ ?salad))
	(salat (name ?salad))
	(getraenk (name ~ ?salad))
	=> (printout t ?salad crlf)
)

(fire)

(defrule tst2
	(wurst (name ?x) (farbe ?f) )
	(salat (name ?y) (farbe ?f) )
	=> (printout t ?x ?y crlf)
)
(fire)

(defrule tst
	(wurst (name ~ ?salad))
	(salat (name ?salad))
	(getraenk (name ~ ?salad))
	=> (printout t ?salad crlf)
)

(defrule megarule
		(salat (farbe ~ "weiss")(name ?weight) )
	=> (printout t ?weight  crlf)
)

(fire)

(defrule eineandereregelf
	?x <- (wurst)
	(test (less (fact-slot-value (get-fact-id ?x) "gewicht") 290) )
	=> (printout t "jep " ?x " hat gewicht <290 nämlich " (fact-slot-value (get-fact-id ?x) "gewicht")  crlf)
)

(fire)

(defrule six
	?x <- (wurst (gewicht ?y & :(less ?y ?z) ))
	(salat (name "kartoffelsalat") (gewicht ?z))
	=>
	(printout t "wurst die schwerer als kartoffelsalat ist: " (get-fact-id  ?x) crlf)
)
(fire)

(defrule foo
(wurst (farbe a & b & c & d & e | f | g & h))
=>
)

(defrule ababab
	(salat (farbe ?farbe))
	?x <- (wurst (farbe ?farbe))
=>
	(printout t (get-fact-id ?x) crlf )
)
(fire)

(defrule megarule
	(wurst (name ?wurstname) (spitzname ?wurstname) (farbe ?farbe))
	(salat (farbe ?farbe)(name ?salatname) )
	=> (printout t "Die Wurst " ?wurstname " und der Salat " ?salatname " haben dieselbe Farbe, naemlich " ?farbe "! Ausserdem hat die Wurst denselben Spitznamen wie Name"  crlf)
)

(fire)

(defrule megarule
	(wurst (name ?wurstname) (spitzname ?wurstname) (farbe ?farbe))
	(salat (farbe ?farbe)(name ?salatname) )
	=> (printout t "Die Wurst " ?wurstname " und der Salat " ?salatname " haben dieselbe Farbe, naemlich " ?farbe "! Ausserdem hat die Wurst denselben Spitznamen wie Name"  crlf)
)

(fire)

(defrule tst2
	(wurst (name ?x) (spitzname ?y))
	=> (printout t ?x  crlf)
)

(defrule tst
	(wurst (name ~ ?salad))
	(salat (name ?salad))
	(getraenk (name ~ ?salad))
	=> (printout t ?salad crlf)
)

(defrule megarule1
	(salat (farbe ?farbe))
	(wurst (farbe ?farbe))
	=> (printout t "Es gibt sowohl einen Salat, als auch eine Wurst, die " ?farbe "ist."  crlf)
)

(defrule megarule
	(wurst (name ?wurstname) (spitzname ?wurstname) )
	(salat (farbe ?farbe))
	(wurst (farbe ?farbe))
	(salat (name ?salatname))
	=> (printout t "Die Wurst " ?wurstname " und der Salat " ?salatname " haben dieselbe Farbe, naemlich " ?farbe "! Ausserdem hat die Wurst denselben Spitznamen wie Name"  crlf)
)

(defrule zero
 => (printout t "boombam" crlf)
)

(defrule one
	(wurst (name ?x))
	=> (printout t "rule with one condition fired " ?x crlf)
)

(defrule two
	(wurst (name "bratwurst"))
	(wurst (farbe "weiss"))
	=> (printout t "rule with two conditions fired " crlf)
)

(defrule three
	(wurst (name "wienerwurst"))
	=> (printout t "rule with one condition fired - wienerwurst" crlf)
)

(defrule four
	?x <- (wurst (name "wienerwurst"))
	=>
	(printout t "rule with one binding fired - wienerwurst" crlf)
	(printout t "fact id of the wienerwurst fact" (get-fact-id  ?x) crlf)
)

(defrule five
	?x <- (wurst (name "wienerwurst") (gewicht ?y:&(> ?y 111))
	=>
	(printout t "rule with one predicate constraint fired - wienerwurst" crlf)
	(printout t "fact id of the wienerwurst fact" (get-fact-id  ?x) crlf)
)

(defrule six
	?x <- (wurst (gewicht ?y:&(> ?y ?z))
	(salat (name "kartoffelsalat") (gewicht ?z))
	=>
	(printout t "rule with one predicate constraint and an internal join fired" crlf)
	(printout t "fact id of the wienerwurst fact" (get-fact-id  ?x) crlf)
)

(fire)

(deftemplate wurst (slot name) (slot spitzname) (slot farbe)  (slot gewicht))
(deftemplate salat (slot name) (slot farbe) (slot dazupasst) (slot gewicht))
(deftemplate getraenk (slot name) (slot farbe) )
(deftemplate farbe (slot name) (slot red) (slot green) (slot blue) )

(assert (wurst (name "bratwurst")(spitzname "bratwosch")(farbe "weiss")(gewicht 100) ))
(assert (wurst (name "weisswurst")(spitzname "weisswurst")(farbe "weiss")(gewicht 200) ))
(assert (wurst (name "wienerwurst")(spitzname "wiener")(farbe "rot")(gewicht 300) ))
(assert (wurst (name "gemuesewurst")(spitzname "gemuesewurst")(farbe "gruen")(gewicht 400) ))
(assert (wurst (name "senfwurst") (spitzname "senfi") (farbe "gelb") (gewicht 200) ))
(assert (salat (name "kartoffelsalat")(farbe "weiss")(gewicht 220)(dazupasst "weisswurst") ))
(assert (salat (name "gurkensalat")(farbe "weiss")(dazupasst "spaghetti")(gewicht 320) ))
(assert (salat (name "gelbebohnensalat") (farbe "gelb") (dazupasst "knoblauchmarmelade") (gewicht 123) ))
(assert (getraenk (name "wasser") (farbe "schwarz") ))
(assert (getraenk (name "cola") (farbe "schwarz")   ))
(assert (getraenk (name "kartoffelsalatdrink") (farbe "weiss") ))

(assert (farbe (name weiss) (red 1) (green 1) (blue 1)))
(assert (farbe (name schwarz) (red 0) (green 0) (blue 0)))
(assert (farbe (name rot) (red 1) (green 0) (blue 0)))
(assert (farbe (name gruen) (red 0) (green 1) (blue 0)))
(assert (farbe (name blau) (red 0) (green 0) (blue 1)))
(assert (farbe (name gelb) (red 1) (green 1) (blue 0)))

(defrule nichtgelbpaar
	(wurst (farbe ?wurstfarbe) (name ?wurstname) )
	(salat (farbe ?salatfarbe) (name ?salatname) )
	(farbe (name ?wurstfarbe & ?salatfarbe & ~ gelb) (red ?rot) (green ?gruen) (blue ?blau) )
	=>
	(printout t "Ein Wurst/Salat Paar mit gleicher Farbe, die nicht Gelb ist, ist " ?wurstname "/" ?salatname " und hat die RGB Farbanteile " ?rot "," ?gruen "," ?blau "!" crlf)
)

(fire)

(defrule babaam
	(or
		(not (wurst (name "weisswurst") )  )
		(not (wurst (name "bratwurst") )  )
	)
	=>
	(printout t "es gibt entweder keine w oder keine b" crlf)
)

(fire)

(defrule vorschlag
 	(salat (name ?salatname) (dazupasst ?match))
 	(not
 		(wurst (name ?match))
  	)
  	(not
 		(wurst (gewicht 300))
  	)
  	=>
 	(printout t "man kann einen " ?salatname " essen." crlf)
)

(defrule tst
	(wurst (name ~ ?salad))
	(salat (name ?salad))
	(getraenk (name ~ ?salad))
	=> (printout t ?salad crlf)
)

(fire)

(defrule tst2
	(wurst (name ?x) (farbe ?f) )
	(salat (name ?y) (farbe ?f) )
	=> (printout t ?x ?y crlf)
)
(fire)

(defrule tst
	(wurst (name ~ ?salad))
	(salat (name ?salad))
	(getraenk (name ~ ?salad))
	=> (printout t ?salad crlf)
)

(defrule megarule
		(salat (farbe ~ "weiss")(name ?weight) )
	=> (printout t ?weight  crlf)
)

(fire)

(defrule eineandereregelf
	?x <- (wurst)
	(test (less (fact-slot-value (get-fact-id ?x) "gewicht") 290) )
	=> (printout t "jep " ?x " hat gewicht <290 nämlich " (fact-slot-value (get-fact-id ?x) "gewicht")  crlf)
)

(fire)

(defrule six
	?x <- (wurst (gewicht ?y & :(less ?y ?z) ))
	(salat (name "kartoffelsalat") (gewicht ?z))
	=>
	(printout t "wurst die schwerer als kartoffelsalat ist: " (get-fact-id  ?x) crlf)
)
(fire)

(defrule foo
(wurst (farbe a & b & c & d & e | f | g & h))
=>
)

(defrule ababab
	(salat (farbe ?farbe))
	?x <- (wurst (farbe ?farbe))
=>
	(printout t (get-fact-id ?x) crlf )
)
(fire)

(defrule megarule
	(wurst (name ?wurstname) (spitzname ?wurstname) (farbe ?farbe))
	(salat (farbe ?farbe)(name ?salatname) )
	=> (printout t "Die Wurst " ?wurstname " und der Salat " ?salatname " haben dieselbe Farbe, naemlich " ?farbe "! Ausserdem hat die Wurst denselben Spitznamen wie Name"  crlf)
)

(fire)

(defrule megarule
	(wurst (name ?wurstname) (spitzname ?wurstname) (farbe ?farbe))
	(salat (farbe ?farbe)(name ?salatname) )
	=> (printout t "Die Wurst " ?wurstname " und der Salat " ?salatname " haben dieselbe Farbe, naemlich " ?farbe "! Ausserdem hat die Wurst denselben Spitznamen wie Name"  crlf)
)

(fire)

(defrule tst2
	(wurst (name ?x) (spitzname ?y))
	=> (printout t ?x  crlf)
)

(defrule tst
	(wurst (name ~ ?salad))
	(salat (name ?salad))
	(getraenk (name ~ ?salad))
	=> (printout t ?salad crlf)
)

(defrule megarule1
	(salat (farbe ?farbe))
	(wurst (farbe ?farbe))
	=> (printout t "Es gibt sowohl einen Salat, als auch eine Wurst, die " ?farbe "ist."  crlf)
)

(defrule megarule
	(wurst (name ?wurstname) (spitzname ?wurstname) )
	(salat (farbe ?farbe))
	(wurst (farbe ?farbe))
	(salat (name ?salatname))
	=> (printout t "Die Wurst " ?wurstname " und der Salat " ?salatname " haben dieselbe Farbe, naemlich " ?farbe "! Ausserdem hat die Wurst denselben Spitznamen wie Name"  crlf)
)

(defrule zero
 => (printout t "boombam" crlf)
)

(defrule one
	(wurst (name ?x))
	=> (printout t "rule with one condition fired " ?x crlf)
)

(defrule two
	(wurst (name "bratwurst"))
	(wurst (farbe "weiss"))
	=> (printout t "rule with two conditions fired " crlf)
)

(defrule three
	(wurst (name "wienerwurst"))
	=> (printout t "rule with one condition fired - wienerwurst" crlf)
)

(defrule four
	?x <- (wurst (name "wienerwurst"))
	=>
	(printout t "rule with one binding fired - wienerwurst" crlf)
	(printout t "fact id of the wienerwurst fact" (get-fact-id  ?x) crlf)
)

(defrule five
	?x <- (wurst (name "wienerwurst") (gewicht ?y:&(> ?y 111))
	=>
	(printout t "rule with one predicate constraint fired - wienerwurst" crlf)
	(printout t "fact id of the wienerwurst fact" (get-fact-id  ?x) crlf)
)

(defrule six
	?x <- (wurst (gewicht ?y:&(> ?y ?z))
	(salat (name "kartoffelsalat") (gewicht ?z))
	=>
	(printout t "rule with one predicate constraint and an internal join fired" crlf)
	(printout t "fact id of the wienerwurst fact" (get-fact-id  ?x) crlf)
)

(fire)