lib/cortex/Library.clp: Rewrote Library.clp to take advantage of library-files

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without ;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Library.clp - Defines the cortex module and loads all other corresponding
; files.
;
; Written by Joshua Scoggins
; Started on 2/14/2013
;------------------------------------------------------------------------------
; Define the module
;------------------------------------------------------------------------------
(defmodule cortex
           (import init ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
; Load the corresponding types and functions
;------------------------------------------------------------------------------
(library-files "cortex"
               "core/Loader.clp"
               "io/Loader.clp"
               "parsing/Loader.clp")
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Library.clp - Defines the cortex module and loads all other corresponding
; files.
;
; Written by Joshua Scoggins
; Started on 2/14/2013
;------------------------------------------------------------------------------
; Define the module
;------------------------------------------------------------------------------
(defmodule cortex (export ?ALL))
;------------------------------------------------------------------------------
; Load the corresponding types and functions
;------------------------------------------------------------------------------
(batch* "lib/cortex/core/Loader.clp")
(batch* "lib/cortex/io/Loader.clp")
(batch* "lib/cortex/parsing/Loader.clp")
;------------------------------------------------------------------------------


Added another simple application

Added another simple application

This one shows off how to do menus and have areas which different things
can occur in.

(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)

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


Added the Object base type.

Added the Object base type.

The object base type is my own object class that all other objects in the
adventure engine inherit from. Not only, does this class provide basic
reflection capabilities but also provides a parent field to define ownership.

;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.
;------------------------------------------------------------------------------
(defclass Object (is-a USER)
 "Custom base type of all objects in the adventure engine. It has automatic
 reflective capabilities in the form of the Class and ID fields."
 (slot class (visibility public) (type SYMBOL))
 (slot id (visibility public) (type SYMBOL))
 (slot parent (visibility public) (default-dynamic nil)))

(defmessage-handler TaggedObject init after ()
 (bind ?self:ID (instance-name-to-symbol (instance-name ?self)))
 (bind ?self:Class (class ?self)))

error: pathspec 'src/adventure/Object.clp' did not match any file(s) known to git


Reduced rule complexity in the Store and Load dependency rules

I realized that having the complex pattern match occur as the first rule will
reduce the match set because there are usually fewer basic blocks than
instructions. The complexity of the pattern match is offset by reducing the
number of elements in the associated match network.

;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.
;------------------------------------------------------------------------------
; BlockDependencyCreation.clp - Contains rules pertaining to the creation of
; data dependencies between different instructions inside of a basic block
; Written by Joshua Scoggins (7/1/2012)
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkLocalDependency-Call
			(declare (salience 1))
			(object (is-a CallInstruction)
					  (parent ?p)
					  (id ?t0)
					  (ArgumentOperands $? ?o $?))
			(object (is-a Instruction)
					  (id ?o)
					  (parent ?p))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?o => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t0 => ?o))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkLocalDependency
			(object (is-a Instruction&~CallInstruction)
					  (parent ?p)
					  (id ?t0)
					  (Operands $? ?o $?))
			(object (is-a Instruction)
					  (id ?o)
					  (parent ?p))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?o => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t0 => ?o))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkInstructionsThatHappenBeforeCall-WritesToMemory
			;the parent is implied by the fact that it's part of the basic block
			(object (is-a BasicBlock)
					  (contents $?before ?n0 $?))
			(object (is-a CallInstruction)
					  (id ?n0)
					  (MayWriteToMemory TRUE))
			=>
			(progn$ (?n1 ?before)
					  (assert (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?n1 => ?n0))
								 (message (to dependency-analysis)
											 (action instruction-consumes)
											 (arguments ?n0 => ?n1)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkInstructionsThatHappenBeforeCall-HasSideEffects
			;the parent is implied by the fact that it's part of the basic block
			(Stage Analysis $?)
			(object (is-a BasicBlock)
					  (contents $?a ?n0 $?))
			(object (is-a CallInstruction)
					  (id ?n0)
					  (MayHaveSideEffects TRUE))
			=>
			(progn$ (?n1 ?a)
					  (assert (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?n1 => ?n0))
								 (message (to dependency-analysis)
											 (action instruction-consumes)
											 (arguments ?n0 => ?n1)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkCallInstructionDependency-ModifiesMemory
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call could modify memory."
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?name $?rest))
			(object (is-a CallInstruction)
					  (id ?name)
					  ;removing parent match reduces join network complexity
					  (MayWriteToMemory TRUE))
			=>
			(assert (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?p)))
			(progn$ (?following ?rest)
					  (assert (message (to dependency-analysis)
											 (action instruction-has-a-call-barrier)
											 (arguments ?following))
								 ;(message (to dependency-analysis)
								 ;	      (action instruction-consumes)
								 ;		   (arguments ?following => ?name))
								 (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?name => ?following)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkCallInstructionDependency-InlineAsm
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call is inline asm."
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?name $?rest))
			(object (is-a CallInstruction)
					  (id ?name)
					  ;removing parent reduces join network complexity
					  (IsInlineAsm TRUE))
			=>
			(assert (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?p)))
			(progn$ (?following ?rest)
					  (assert (message (to dependency-analysis)
											 (action instruction-has-a-call-barrier)
											 (arguments ?following))
								 ;(message (to dependency-analysis)
								 ;	      (action instruction-consumes)
								 ;		   (arguments ?following => ?name))
								 (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?name => ?following)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkCallInstructionDependency-SideEffects
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call has side effects."
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?name $?rest))
			(object (is-a CallInstruction)
					  (id ?name)
					  ;removing parent reduces join network complexity
					  (MayHaveSideEffects TRUE))
			=>
			(assert (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?p)))
			(progn$ (?following ?rest)
					  (assert (message (to dependency-analysis)
											 (action instruction-has-a-call-barrier)
											 (arguments ?following))
								 ;(message (to dependency-analysis)
								 ;	      (action instruction-consumes)
								 ;		   (arguments ?following => ?name))
								 (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?name => ?following)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::FlagCallBarrierForDiplomat-HasParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			?d <- (object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier FALSE)
							  (parent ?p))
			(exists (object (is-a Diplomat)
								 (id ?p)))
			=>
			(modify ?fct (arguments ?p))
			(modify-instance ?d (HasCallBarrier TRUE)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::PropagateCallBarrierForDiplomat-HasParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			(object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier TRUE)
							  (parent ?p))
			(exists (object (is-a Diplomat)
								 (id ?p)))
			=>
			(modify ?fct (arguments ?p)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::FlagCallBarrierForDiplomat-NoParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			?d <- (object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier FALSE)
							  (parent ?p))
			(not (exists (object (is-a Diplomat)
										(id ?p))))
			=>
			(retract ?fct)
			(modify-instance ?d (HasCallBarrier TRUE)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::PropagateCallBarrierForDiplomat-NoParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			(object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier TRUE)
							  (parent ?p))
			(not (exists (object (is-a Diplomat)
										(id ?p))))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::MarkHasACallDependency-Set
			?fct <- (message (to dependency-analysis)
								  (action instruction-has-a-call-barrier)
								  (arguments ?target))
			?inst <- (object (is-a Instruction)
								  (id ?target)
								  (HasCallDependency FALSE))
			=>
			(retract ?fct)
			(modify-instance ?inst (HasCallDependency TRUE)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::MarkHasACallDependency-Ignore
			?fct <- (message (to dependency-analysis)
								  (action instruction-has-a-call-barrier)
								  (arguments ?target))
			(object (is-a Instruction)
								  (id ?target)
								  (HasCallDependency TRUE))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::StoreDependency-UNKNOWN
			(object (is-a BasicBlock)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction)
					  (id ?t0)
					  (MemoryTarget UNKNOWN))
			(object (is-a StoreInstruction|LoadInstruction)
					  (id ?t1))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::LoadDependency-UNKNOWN
			(object (is-a BasicBlock)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a LoadInstruction)
					  (id ?t0)
					  (MemoryTarget UNKNOWN))
			(object (is-a StoreInstruction)
					  (id ?t1))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::Store=>LoadDependency
			(object (is-a BasicBlock)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction)
					  (id ?t0)
					  (MemoryTarget ?sym0&~UNKNOWN))
			(object (is-a LoadInstruction)
					  (id ?t1)
					  (MemoryTarget ?sym0))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::Store=>StoreDependency
			(object (is-a BasicBlock)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction)
					  (id ?t0)
					  (MemoryTarget ?sym0&~UNKNOWN))
			(object (is-a StoreInstruction)
					  (id ?t1)
					  (MemoryTarget ?sym0))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::Load=>StoreDependency
			(object (is-a BasicBlock)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a LoadInstruction)
					  (id ?t0)
					  (MemoryTarget ?sym0&~UNKNOWN))
			(object (is-a StoreInstruction)
					  (id ?t1)
					  (MemoryTarget ?sym0))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
; BlockDependencyCreation.clp - Contains rules pertaining to the creation of
; data dependencies between different instructions inside of a basic block
; Written by Joshua Scoggins (7/1/2012)
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkLocalDependency-Call
			(declare (salience 1))
			(object (is-a CallInstruction)
					  (parent ?p)
					  (id ?t0)
					  (ArgumentOperands $? ?o $?))
			(object (is-a Instruction)
					  (id ?o)
					  (parent ?p))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?o => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t0 => ?o))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkLocalDependency
			(object (is-a Instruction&~CallInstruction)
					  (parent ?p)
					  (id ?t0)
					  (Operands $? ?o $?))
			(object (is-a Instruction)
					  (id ?o)
					  (parent ?p))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?o => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t0 => ?o))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkInstructionsThatHappenBeforeCall-WritesToMemory
			;the parent is implied by the fact that it's part of the basic block
			(object (is-a BasicBlock)
					  (contents $?before ?n0 $?))
			(object (is-a CallInstruction)
					  (id ?n0)
					  (MayWriteToMemory TRUE))
			=>
			(progn$ (?n1 ?before)
					  (assert (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?n1 => ?n0))
								 (message (to dependency-analysis)
											 (action instruction-consumes)
											 (arguments ?n0 => ?n1)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkInstructionsThatHappenBeforeCall-HasSideEffects
			;the parent is implied by the fact that it's part of the basic block
			(Stage Analysis $?)
			(object (is-a BasicBlock)
					  (contents $?a ?n0 $?))
			(object (is-a CallInstruction)
					  (id ?n0)
					  (MayHaveSideEffects TRUE))
			=>
			(progn$ (?n1 ?a)
					  (assert (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?n1 => ?n0))
								 (message (to dependency-analysis)
											 (action instruction-consumes)
											 (arguments ?n0 => ?n1)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkCallInstructionDependency-ModifiesMemory
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call could modify memory."
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?name $?rest))
			(object (is-a CallInstruction)
					  (id ?name)
					  ;removing parent match reduces join network complexity
					  (MayWriteToMemory TRUE))
			=>
			(assert (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?p)))
			(progn$ (?following ?rest)
					  (assert (message (to dependency-analysis)
											 (action instruction-has-a-call-barrier)
											 (arguments ?following))
								 ;(message (to dependency-analysis)
								 ;	      (action instruction-consumes)
								 ;		   (arguments ?following => ?name))
								 (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?name => ?following)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkCallInstructionDependency-InlineAsm
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call is inline asm."
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?name $?rest))
			(object (is-a CallInstruction)
					  (id ?name)
					  ;removing parent reduces join network complexity
					  (IsInlineAsm TRUE))
			=>
			(assert (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?p)))
			(progn$ (?following ?rest)
					  (assert (message (to dependency-analysis)
											 (action instruction-has-a-call-barrier)
											 (arguments ?following))
								 ;(message (to dependency-analysis)
								 ;	      (action instruction-consumes)
								 ;		   (arguments ?following => ?name))
								 (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?name => ?following)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis::MarkCallInstructionDependency-SideEffects
			"Creates a series of dependencies for all instructions following a
			call instruction if it turns out that the call has side effects."
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?name $?rest))
			(object (is-a CallInstruction)
					  (id ?name)
					  ;removing parent reduces join network complexity
					  (MayHaveSideEffects TRUE))
			=>
			(assert (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?p)))
			(progn$ (?following ?rest)
					  (assert (message (to dependency-analysis)
											 (action instruction-has-a-call-barrier)
											 (arguments ?following))
								 ;(message (to dependency-analysis)
								 ;	      (action instruction-consumes)
								 ;		   (arguments ?following => ?name))
								 (message (to dependency-analysis)
											 (action instruction-produces)
											 (arguments ?name => ?following)))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::FlagCallBarrierForDiplomat-HasParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			?d <- (object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier FALSE)
							  (parent ?p))
			(exists (object (is-a Diplomat)
								 (id ?p)))
			=>
			(modify ?fct (arguments ?p))
			(modify-instance ?d (HasCallBarrier TRUE)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::PropagateCallBarrierForDiplomat-HasParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			?d <- (object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier TRUE)
							  (parent ?p))
			(exists (object (is-a Diplomat)
								 (id ?p)))
			=>
			(modify ?fct (arguments ?p)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::FlagCallBarrierForDiplomat-NoParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			?d <- (object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier FALSE)
							  (parent ?p))
			(not (exists (object (is-a Diplomat)
										(id ?p))))
			=>
			(retract ?fct)
			(modify-instance ?d (HasCallBarrier TRUE)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::PropagateCallBarrierForDiplomat-NoParent
			;(declare (salience -10))
			?fct <- (message (to dependency-analysis)
								  (action element-has-a-call-barrier)
								  (arguments ?z))
			?d <- (object (is-a Diplomat)
							  (id ?z)
							  (HasCallBarrier TRUE)
							  (parent ?p))
			(not (exists (object (is-a Diplomat)
										(id ?p))))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::MarkHasACallDependency-Set
			?fct <- (message (to dependency-analysis)
								  (action instruction-has-a-call-barrier)
								  (arguments ?target))
			?inst <- (object (is-a Instruction)
								  (id ?target)
								  (HasCallDependency FALSE))
			=>
			(retract ?fct)
			(modify-instance ?inst (HasCallDependency TRUE)))
;------------------------------------------------------------------------------
(defrule dependency-analysis-analysis-update::MarkHasACallDependency-Ignore
			?fct <- (message (to dependency-analysis)
								  (action instruction-has-a-call-barrier)
								  (arguments ?target))
			?inst <- (object (is-a Instruction)
								  (id ?target)
								  (HasCallDependency TRUE))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::StoreDependency-UNKNOWN
			(object (is-a StoreInstruction)
					  (MemoryTarget UNKNOWN)
					  (id ?t0)
					  (parent ?p))
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction|LoadInstruction)
					  (id ?t1))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::LoadDependency-UNKNOWN
			(object (is-a LoadInstruction)
					  (parent ?p)
					  (id ?t0)
					  (MemoryTarget UNKNOWN))
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction)
					  (id ?t1))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::Store=>LoadDependency
			(object (is-a StoreInstruction)
					  (parent ?p)
					  (id ?t0)
					  (MemoryTarget ?sym0&~UNKNOWN))
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a LoadInstruction)
					  (id ?t1)
					  (parent ?p)
					  (MemoryTarget ?sym0))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::Store=>StoreDependency
			(object (is-a StoreInstruction)
					  (parent ?p)
					  (id ?t0)
					  (MemoryTarget ?sym0&~UNKNOWN))
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction)
					  (id ?t1)
					  (MemoryTarget ?sym0))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------
(defrule dependency-analysis-extended-memory-analysis::Load=>StoreDependency
			(object (is-a LoadInstruction)
					  (parent ?p)
					  (id ?t0)
					  (MemoryTarget ?sym0&~UNKNOWN))
			(object (is-a BasicBlock)
					  (id ?p)
					  (contents $? ?t0 $? ?t1 $?))
			(object (is-a StoreInstruction)
					  (id ?t1)
					  (MemoryTarget ?sym0))
			=>
			(assert (message (to dependency-analysis)
								  (action instruction-consumes)
								  (arguments ?t1 => ?t0))
					  (message (to dependency-analysis)
								  (action instruction-produces)
								  (arguments ?t0 => ?t1))))
;------------------------------------------------------------------------------


Fixed symbol-to-pointer-list to use instance-address

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
(deffunction types::symbol-to-pointer-list
				 "Converts a given list of symbols that represent InteropObjects and pulls the
				 pointer value out of it. This function assumes order is important"
				 (?list)
				 (bind ?result (create$))
				 (progn$ (?e ?list)
							(bind ?obj (instance-address *
																  (symbol-to-instance-name ?e)))
							(bind ?result (create$ ?result (send ?obj get-Pointer))))
				 (return ?result))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------

(deffunction types::symbol-to-pointer-list
				 "Converts a given list of symbols that represent InteropObjects and pulls the
				 pointer value out of it. This function assumes order is important"
				 (?list)
				 (bind ?result (create$))
				 (progn$ (?e ?list)
							 (bind ?obj (symbol-to-instance-name ?e))
							 (bind ?result (create$ ?result (send ?obj get-Pointer))))
				 (return ?result))


Replaced is-executing-environment with is-currently-executing-environment

I had set "is-currently-executing-environment" as the name of the function that
was used to find out if the currently executing environment. So I changed the
reference to is-executing-environment to is-currently-executing-environment
since the new term is more descriptive

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Environment.clp - A wrapper over a CLIPS environment
;------------------------------------------------------------------------------
(defclass core::Environment
 "A wrapper over a clips environment"
 (is-a Object InteropObject)
 (slot pointer (type INTEGER EXTERNAL-ADDRESS) (source composite) (access initialize-only)
  (range 0 0) (default-dynamic 0)))

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

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

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

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

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

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

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

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

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

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Environment.clp - A wrapper over a CLIPS environment
;------------------------------------------------------------------------------
(defclass core::Environment
 "A wrapper over a clips environment"
 (is-a Object InteropObject)
 (slot pointer (type INTEGER EXTERNAL-ADDRESS) (source composite) (access initialize-only)
  (range 0 0) (default-dynamic 0)))

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

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

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

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

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

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

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

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

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