Started porting WavefrontAdvancement.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-advance-init::MoveContentsToDeleteNodes
         "Moves blocks out of the contents into the closed list"
         (declare (salience 2701))
         ?wave <- (object (is-a Wavefront)
                          (id ?z)
                          (parent ?r)
                          (contents $?c)
                          (Closed $?cl))
         (test (or (> (length$ ?c) 0)
                   (> (length$ ?cl) 0)))
         =>
         (slot-insert$ ?wave DeleteNodes 1 ?c ?cl))
;------------------------------------------------------------------------------
(defrule wavefront-schedule-advance-identify::MarkShouldStayOnWavefront
         (declare (salience 343))
         ?wave <- (object (is-a Wavefront)
                          (id ?q)
                          (parent ?r)
                          (DeleteNodes $?a ?b $?c)
                          (Closed $?clos)
                          (contents $?contents))

         ?bb <- (object (is-a Diplomat)
                        (id ?b)
                        (NextPathElements ?s))
         (object (is-a Diplomat)
                 (id ?s)
                 (PreviousPathElements $?ppe))
         (test (not (subsetp ?ppe (create$ ?a ?b ?c))))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b))
         =>
         (object-pattern-match-delay
           (if (not (member$ ?b $?clos)) then
             (bind ?ind (member$ ?b $?contents))
             (slot-delete$ ?wave Contents ?ind ?ind)
             (modify-instance ?wave (Closed $?clos ?b)
                              (DeleteNodes $?a $?c))
             else
             (modify-instance ?wave (DeleteNodes $?a $?c)))))
;------------------------------------------------------------------------------
(defrule wavefront-schedule-advance::DeleteElementFromWavefront
         (declare (salience 180))
         ?wave <- (object (is-a Wavefront)
                          (id ?id)
                          (parent ?r)
                          (DeleteNodes ?a $?))
         (object (is-a Diplomat)
                 (id ?a)
                 (NextPathElements $?npe))
         =>
         ;TODO: Continue to port here
         (object-pattern-match-delay
           (bind ?ind (member$ ?a (send ?wave get-Contents)))
           (bind ?ind2 (member$ ?a (send ?wave get-Closed)))
           (slot-delete$ ?wave DeleteNodes 1 1)
           (if ?ind then (slot-delete$ ?wave Contents ?ind ?ind))
           (if ?ind2 then (slot-delete$ ?wave Closed ?ind2 ?ind2))
           (assert (Add into ?id blocks $?npe))))
;------------------------------------------------------------------------------
(defrule PutSuccessorsOntoWavefront-Match
         (declare (salience 100))
         (Stage WavefrontSchedule $?)
         (Substage AdvanceEnd $?)
         ?fct <- (Add into ?id blocks ?next $?rest)
         ?wave <- (object (is-a Wavefront) (ID ?id))
         =>
         (retract ?fct)
         ;I know that this is procedural but I really want to get this done
         (assert (Add into ?id blocks $?rest))
         (if (not (member$ ?next (send ?wave get-Contents))) then
           (slot-insert$ ?wave Contents 1 ?next)))
;------------------------------------------------------------------------------
(defrule PutSuccessorsOntoWavefront-NoMoreElements
         (declare (salience 100))
         (Stage WavefrontSchedule $?)
         (Substage AdvanceEnd $?)
         ?fct <- (Add into ? blocks)
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-update::PonderRestartOfWavefrontScheduling
         ?fct <- (message (to wavefront-scheduling-update)
                          (from pipeline)
                          (action initial-fact))
         ?obj <- (object (is-a pass-description)
                         (passes $?passes))
         =>
         (retract ?fct)
         (bind ?instances (find-all-instances ((?wave Wavefront))
                                              (> (length$ ?wave:contents) 0)))
         (if (> (length$ ?instances) 0) then
           (modify-instance ?obj
                            (passes wavefront-scheduling-init
                                    wavefront-scheduling-identify
                                    wavefront-scheduling-phi-identify
                                    wavefront-scheduling-phi-node
                                    wavefront-scheduling-phi-node-update
                                    wavefront-scheduling-pathing
                                    wavefront-scheduling-strip
                                    wavefront-scheduling-inject
                                    wavefront-scheduling-acquire
                                    wavefront-scheduling-slice
                                    wavefront-scheduling-analyze-init
                                    wavefront-scheduling-pre-generate-analyze
                                    wavefront-scheduling-generate-analyze
                                    wavefront-scheduling-analyze
                                    wavefront-scheduling-slice-analyze
                                    wavefront-scheduling-merge-init
                                    wavefront-scheduling-merge
                                    wavefront-scheduling-merge-update
                                    wavefront-scheduling-reopen-blocks
                                    wavefront-scheduling-ponder
                                    wavefront-scheduling-post-ponder
                                    wavefront-scheduling-rename
                                    wavefront-scheduling-dependency-analysis
                                    wavefront-scheduling-advance-init
                                    wavefront-scheduling-advance-identify
                                    wavefront-scheduling-advance
                                    wavefront-scheduling-advance-end
                                    wavefront-scheduling-update
                                    $?passes))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-final::RetractUnlinkedInstructions
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (UnlinkedInstructions ?i $?rest))
         ?instruction <- (object (is-a Instruction)
                                 (id ?i)
                                 (parent ?b)
                                 (pointer ?ptr))
         (object (is-a PathAggregate)
                 (parent ?b)
                 (InstructionPropagation $? ?i ?new ?b ! $?))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         =>
         ;this is a little gross but it is a very easy way to ensure that
         ;things work correctly so that the LLVM ModuleVerifier doesn't come
         ;down like a hammer on what we're doing
         (object-pattern-match-delay
           (llvm-replace-all-uses ?ptr ?nPtr)
           (modify-instance ?bb (UnlinkedInstructions $?rest))
           (llvm-unlink-and-delete-instruction ?ptr)
           (unmake-instance ?instruction)))
;------------------------------------------------------------------------------

;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 MoveContentsToDeleteNodes
			"Moves blocks out of the contents into the closed list"
			(declare (salience 2701))
			(Stage WavefrontSchedule $?)
			(Substage AdvanceInit $?)
			?wave <- (object (is-a Wavefront) (ID ?z) (Parent ?r)
								  (Contents $?c) (Closed $?cl))
			(test (or (> (length$ ?c) 0) (> (length$ ?cl) 0)))
			=>
			(slot-insert$ ?wave DeleteNodes 1 ?c ?cl))
;------------------------------------------------------------------------------
(defrule MarkShouldStayOnWavefront
			(declare (salience 343))
			(Stage WavefrontSchedule $?)
			(Substage AdvanceIdentify $?)
			?wave <- (object (is-a Wavefront) (ID ?q) (Parent ?r)
								  (DeleteNodes $?a ?b $?c))
			?bb <- (object (is-a Diplomat) (ID ?b) (NextPathElements ?s))
			(object (is-a Diplomat) (ID ?s) (PreviousPathElements $?ppe))
			(test (not (subsetp ?ppe (send ?wave get-DeleteNodes))))
			?agObj <- (object (is-a PathAggregate) (Parent ?b))
			=>
      (object-pattern-match-delay
			(if (not (member$ ?b (send ?wave get-Closed))) then
			  (bind ?ind (member$ ?b (send ?wave get-Contents)))
			  (slot-delete$ ?wave Contents ?ind ?ind)
			  (slot-insert$ ?wave Closed 1 ?b))
			(modify-instance ?wave (DeleteNodes $?a $?c))))
;------------------------------------------------------------------------------
(defrule DeleteElementFromWavefront
			(declare (salience 180))
			(Stage WavefrontSchedule $?)
			(Substage Advance $?)
			?wave <- (object (is-a Wavefront) (ID ?id) (Parent ?r)
								  (DeleteNodes ?a $?))
			(object (is-a Diplomat) (ID ?a) (NextPathElements $?npe))
			=>
      (object-pattern-match-delay
			(bind ?ind (member$ ?a (send ?wave get-Contents)))
			(bind ?ind2 (member$ ?a (send ?wave get-Closed)))
			(slot-delete$ ?wave DeleteNodes 1 1)
			(if ?ind then (slot-delete$ ?wave Contents ?ind ?ind))
			(if ?ind2 then (slot-delete$ ?wave Closed ?ind2 ?ind2))
			(assert (Add into ?id blocks $?npe))))
;------------------------------------------------------------------------------
(defrule PutSuccessorsOntoWavefront-Match
			(declare (salience 100))
			(Stage WavefrontSchedule $?)
			(Substage AdvanceEnd $?)
			?fct <- (Add into ?id blocks ?next $?rest)
			?wave <- (object (is-a Wavefront) (ID ?id))
			=>
			(retract ?fct)
			;I know that this is procedural but I really want to get this done
			(assert (Add into ?id blocks $?rest))
			(if (not (member$ ?next (send ?wave get-Contents))) then
			  (slot-insert$ ?wave Contents 1 ?next)))
;------------------------------------------------------------------------------
(defrule PutSuccessorsOntoWavefront-NoMoreElements
			(declare (salience 100))
			(Stage WavefrontSchedule $?)
			(Substage AdvanceEnd $?)
			?fct <- (Add into ? blocks)
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule PonderRestartOfWavefrontScheduling
			(declare (salience -512))
			(Stage WavefrontSchedule $?)
			?fct <- (Substage Update $?)
			=>
			(bind ?instances (find-all-instances ((?wave Wavefront))
															 (> (length$ ?wave:Contents) 0)))
			(if (> (length$ ?instances) 0) then
			  (retract ?fct)
			  (assert (Substage Init
									  Identify
									  PhiIdentify
									  PhiNode
									  PhiNodeUpdate
									  Pathing
									  Strip
									  Inject
									  Acquire
									  Slice
									  AnalyzeInit
									  GenerateAnalyze0
									  GenerateAnalyze
									  Analyze
									  SliceAnalyze
									  MergeInit
									  Merge
									  MergeUpdate
									  ReopenBlocks
									  Ponder
									  Rename
									  DependencyAnalysis
									  ;ScheduleObjectCreation
									  ;ScheduleObjectUsage
									  ;ResetScheduling
									  ;InitLLVMUpdate
									  ;LLVMUpdate
									  AdvanceInit
									  AdvanceIdentify
									  Advance
									  AdvanceEnd
									  Update))))
;------------------------------------------------------------------------------
(defrule RetractUnlinkedInstructions
			(Stage WavefrontFinal $?)
			?bb <- (object (is-a BasicBlock) (ID ?b)
								(UnlinkedInstructions ?i $?rest))
			?instruction <- (object (is-a Instruction) (ID ?i) (Parent ?b)
											(Pointer ?ptr))
			(object (is-a PathAggregate) (Parent ?b)
					  (InstructionPropagation $? ?i ?new ?b ! $?))
			(object (is-a Instruction) (ID ?new) (Pointer ?nPtr))
			=>
			;this is a little gross but it is a very easy way to ensure that
			;things work correctly
      (object-pattern-match-delay
			(llvm-replace-all-uses ?ptr ?nPtr)
			(modify-instance ?bb (UnlinkedInstructions $?rest))
			(llvm-unlink-and-delete-instruction ?ptr)
			(unmake-instance ?instruction)))
;------------------------------------------------------------------------------


Modified DeclareLibraryFunctions to be defmethods

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; DeclareLibraryFunctions.clp - Defines a series of functions used to
; streamline the loading of libraries in the adventure engine
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
(defgeneric init::load-library "Loads a given library header")
;------------------------------------------------------------------------------
(defgeneric init::library-files "Loads the contents of a target library")
;------------------------------------------------------------------------------
(defmethod init::load-library
  "Loads an adventure engine library from the root of the src folder"
  (?name)
  (generic-load lib ?name Library.clp))
;------------------------------------------------------------------------------
(defmethod init::library-files
  "Loads the files that make up the target library"
  ((?offset LEXEME)
   ($?names LEXEME))
  (generic-load lib ?offset ?names))
;------------------------------------------------------------------------------
(defmethod init::library-files
  "Loads the files that make up the target library"
  ((?offset LEXEME)
   (?names LEXEME MULTIFIELD))
  (generic-load lib ?offset ?names))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; DeclareLibraryFunctions.clp - Defines a series of functions used to
; streamline the loading of libraries in the adventure engine
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
(deffunction init::load-library
 "Loads an adventure engine library from the root of the src folder"
 (?name)
 (batch* (format nil "lib/%s/Library.clp" ?name)))
;------------------------------------------------------------------------------
(deffunction init::library-files
 "Loads the files that make up the target library"
 (?offset $?names)
 (bind ?coreOffset (format nil "lib/%s/%s" ?offset "%s"))
 (progn$ (?a $?names)
  (batch* (format nil ?coreOffset ?a))))
;------------------------------------------------------------------------------


WidgetElement.clp: Removed the message-handler note for raise-event

This will be handled through the use of objects that are events

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; WidgetElement.clp - Base class of all widgets
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
(defclass widget::WidgetElement
 "Base class of all widgets in the adventure engine"
 (is-a Object)
 (slot position-x (type NUMBER))
 (slot position-y (type NUMBER))
 (multislot children (type SYMBOL))
 (slot width (type NUMBER))
 (slot height (type NUMBER)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; WidgetElement.clp - Base class of all widgets
;
; Written by Joshua Scoggins
; Started on 3/11/2013
;------------------------------------------------------------------------------
(defclass widget::WidgetElement
 "Base class of all widgets in the adventure engine"
 (is-a Object)
 (slot position-x (type NUMBER))
 (slot position-y (type NUMBER))
 (multislot children (type SYMBOL))
 (slot width (type NUMBER))
 (slot height (type NUMBER))
 (message-handler raise-event primary))
;------------------------------------------------------------------------------


Start chapter three implementation

Start chapter three implementation

(deftemplate client
	(slot name)
	(slot number)
	(slot city (default Saratov))
)

(client (name Ivanov) (number 1) (city Saratov))
(client (name Petrov) (number 2) (city Saratov))
(client (name Zaizev) (number 3) (city Vorones))

(modify 1 (city Samara))
(modify 2 (name Lelyakin))
(dublicate 3 (number 4))

(assert client (name Kefalic) (number 5) (city Moscow))
(assert client (name Marmonm) (number 6) (city Kazan))

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


Added the Hint type

Added the Hint type

It is a useful class that can be used in a wide variety of situations.
It has a reference count field and associated message-handlers to increment and
decrement it

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Hint.clp - An object used to signify something is a hint. It also has the
; ability to be reference counted if necessary
;------------------------------------------------------------------------------
(defclass core::Hint
  "An object that makes it easy to create temporary entities."
  (is-a core::Object)
  (multislot values (visibility public))
  (slot reference-count (type NUMBER) (visibility public))
  (slot type (visibility public) (type SYMBOL))
  (slot point (visibility public) (type SYMBOL)))
;------------------------------------------------------------------------------
(defmessage-handler core::Hint increment-reference-count ($?by)
"Incrementes the reference count of the given hint.  If no parameters are given
then the default is one. If a parameter is given then that is the value
incremented by. If more than one parameter is given then those numbers are
added together and then added to the current reference count"
						  (bind ?len (length$ ?by))
						  (switch (length$ ?by)
									 (case 0 then
										(bind ?self:reference-count
												(+ 1 ?self:reference-count)))
									 (case 1 then
										(bind ?self:reference-count
												(+ (first$ ?by) ?self:reference-count)))
									 (default
										(bind ?v (eval (format nil "(+ %s)"
																	  (implode$ ?by))))
										(bind ?self:reference-count
												(+ ?self:reference-count ?v)))))
;------------------------------------------------------------------------------
(defmessage-handler core::Hint decrement-reference-count
"Decrements the reference count of the given hint.  If no parameters are given
then the default is one. If a parameter is given then that is the value
decremented by. If more than one parameter is given then those numbers are
added together and then subtracted from the current reference count"
						  ($?by)
						  (bind ?len (length$ ?by))
						  (switch (length$ ?by)
									 (case 0 then
										(bind ?self:reference-count
												(- 1 ?self:reference-count)))
									 (case 1 then
										(bind ?self:reference-count
												(- (first$ ?by) ?self:reference-count)))
									 (default
										;add all of the element together so that the
										;subtraction is correct
										(bind ?v (eval (format nil "(+ %s)"
																	  (implode$ ?by))))
										(bind ?self:reference-count
												(- ?self:reference-count ?v)))))
;------------------------------------------------------------------------------

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


Added the ParentedObject class

Added the ParentedObject class

This class adds a parent field to the standard object class.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Object.clp - Base class of all objects
;------------------------------------------------------------------------------
(defclass core::Object
  "Base class of all objects"
  (is-a USER)
  (slot id (type SYMBOL) (visiblity public) (access initialize-only))
  (slot class (type SYMBOL) (visiblity public) (access initialize-only)))
;------------------------------------------------------------------------------
(defmessage-handler core::Object init around
						  "Initializes the object, setting the id and class of the
						  object" ()
						  (call-next-handler)
						  ;we want to set this information as the last thing before
						  ;we return
						  (bind ?self:id (instance-name-to-symbol
												 (instance-name ?self)))
						  (bind ?self:class (class ?self)))
;------------------------------------------------------------------------------
(defclass core::ParentedObject
  "An object that has a parent field."
  (is-a core::Object)
  (slot parent (type SYMBOL) (visibility public)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Object.clp - Base class of all objects
;------------------------------------------------------------------------------
(defclass core::Object
  "Base class of all objects"
  (is-a USER)
  (slot id (type SYMBOL) (visiblity public) (access initialize-only))
  (slot class (type SYMBOL) (visiblity public) (access initialize-only)))

(defmessage-handler core::Object init around
						  "Initializes the object, setting the id and class of the
						  object" ()
						  (call-next-handler)
						  ;we want to set this information as the last thing before
						  ;we return
						  (bind ?self:id (instance-name-to-symbol
												(instance-name ?self)))
						  (bind ?self:class (class ?self)))


Create task6.clp

Create task6.clp

(deffunction reflect (?s)
 (bind ?s1 "")
 (bind ?n (length ?s))
 (loop-for-count (?i 0 ?n) do
 (bind ?c (sub-string (- ?n ?i) (- ?n ?i) ?s))
 (bind ?s1 (str-cat ?s1 ?c)))
 ?s1)

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


Made LLVMObject a ParentedObject

Made LLVMObject a ParentedObject

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; LLVMObject.clp - Base class for most LLVM objects in the llvm module
;------------------------------------------------------------------------------
(defclass llvm::LLVMObject
  (is-a core::Object core::InteropObject core::ParentedObject)
  (slot Name (visibility public))
  (multislot WritesTo (visibility public))
  (multislot ReadsFrom (visibility public)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; LLVMObject.clp - Base class for most LLVM objects in the llvm module
;------------------------------------------------------------------------------
(defclass llvm::LLVMObject (is-a core::Object core::InteropObject)
  (slot Name (visibility public))
  (multislot WritesTo (visibility public))
  (multislot ReadsFrom (visibility public)))
;------------------------------------------------------------------------------


Finished updating WavefrontAdvancement.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-advance-init::MoveContentsToDeleteNodes
         "Moves blocks out of the contents into the closed list"
         (declare (salience 2701))
         ?wave <- (object (is-a Wavefront)
                          (id ?z)
                          (parent ?r)
                          (contents $?c)
                          (Closed $?cl))
         (test (or (> (length$ ?c) 0)
                   (> (length$ ?cl) 0)))
         =>
         (slot-insert$ ?wave DeleteNodes 1 ?c ?cl))
;------------------------------------------------------------------------------
(defrule wavefront-schedule-advance-identify::MarkShouldStayOnWavefront
         (declare (salience 343))
         ?wave <- (object (is-a Wavefront)
                          (id ?q)
                          (parent ?r)
                          (DeleteNodes $?a ?b $?c)
                          (Closed $?clos)
                          (contents $?contents))

         ?bb <- (object (is-a Diplomat)
                        (id ?b)
                        (NextPathElements ?s))
         (object (is-a Diplomat)
                 (id ?s)
                 (PreviousPathElements $?ppe))
         (test (not (subsetp ?ppe (create$ ?a ?b ?c))))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b))
         =>
         (object-pattern-match-delay
           (if (not (member$ ?b $?clos)) then
             (bind ?ind (member$ ?b $?contents))
             (slot-delete$ ?wave Contents ?ind ?ind)
             (modify-instance ?wave (Closed $?clos ?b)
                              (DeleteNodes $?a $?c))
             else
             (modify-instance ?wave (DeleteNodes $?a $?c)))))
;------------------------------------------------------------------------------
(defrule wavefront-schedule-advance::DeleteElementFromWavefront
         (declare (salience 180))
         ?wave <- (object (is-a Wavefront)
                          (id ?id)
                          (parent ?r)
                          (DeleteNodes ?a $?rest))
         (object (is-a Diplomat)
                 (id ?a)
                 (NextPathElements $?npe))
         =>
         ;TODO: Continue to port here
         (object-pattern-match-delay
           (bind ?ind (member$ ?a (send ?wave get-Contents)))
           (bind ?ind2 (member$ ?a (send ?wave get-Closed)))
           (modify-instance ?wave (DeleteNodes $?rest))
           (if ?ind then (slot-delete$ ?wave Contents ?ind ?ind))
           (if ?ind2 then (slot-delete$ ?wave Closed ?ind2 ?ind2))
           (assert (message (to wavefront-scheduling)
                            (action add-blocks-into)
                            (arguments ?id => $?npe)))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-advance-end::PutSuccessorsOntoWavefront-Match
         ?fct <- (message (to wavefront-scheduling)
                          (action add-blocks-into)
                          (arguments ?id => ?next $?rest))
         ?wave <- (object (is-a Wavefront)
                          (id ?id)
                          (contents $?contents))
         =>
         (modify ?fct (arguments ?id => $?rest))
         (if (not (member$ ?next $?contents)) then
           (modify-instance ?wave (contents $?contents ?next))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-advance-end::PutSuccessorsOntoWavefront-NoMoreElements
         ?fct <- (message (to wavefront-scheduling)
                          (action add-blocks-into)
                          (arguments ?id =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-update::PonderRestartOfWavefrontScheduling
         ?fct <- (message (to wavefront-scheduling-update)
                          (from pipeline)
                          (action initial-fact))
         ?obj <- (object (is-a pass-description)
                         (passes $?passes))
         =>
         (retract ?fct)
         (bind ?instances (find-all-instances ((?wave Wavefront))
                                              (> (length$ ?wave:contents) 0)))
         (if (> (length$ ?instances) 0) then
           (modify-instance ?obj
                            (passes wavefront-scheduling-init
                                    wavefront-scheduling-identify
                                    wavefront-scheduling-phi-identify
                                    wavefront-scheduling-phi-node
                                    wavefront-scheduling-phi-node-update
                                    wavefront-scheduling-pathing
                                    wavefront-scheduling-strip
                                    wavefront-scheduling-inject
                                    wavefront-scheduling-acquire
                                    wavefront-scheduling-slice
                                    wavefront-scheduling-analyze-init
                                    wavefront-scheduling-pre-generate-analyze
                                    wavefront-scheduling-generate-analyze
                                    wavefront-scheduling-analyze
                                    wavefront-scheduling-slice-analyze
                                    wavefront-scheduling-merge-init
                                    wavefront-scheduling-merge
                                    wavefront-scheduling-merge-update
                                    wavefront-scheduling-reopen-blocks
                                    wavefront-scheduling-ponder
                                    wavefront-scheduling-post-ponder
                                    wavefront-scheduling-rename
                                    wavefront-scheduling-dependency-analysis
                                    wavefront-scheduling-advance-init
                                    wavefront-scheduling-advance-identify
                                    wavefront-scheduling-advance
                                    wavefront-scheduling-advance-end
                                    wavefront-scheduling-update
                                    $?passes))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-final::RetractUnlinkedInstructions
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (UnlinkedInstructions ?i $?rest))
         ?instruction <- (object (is-a Instruction)
                                 (id ?i)
                                 (parent ?b)
                                 (pointer ?ptr))
         (object (is-a PathAggregate)
                 (parent ?b)
                 (InstructionPropagation $? ?i ?new ?b ! $?))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         =>
         ;this is a little gross but it is a very easy way to ensure that
         ;things work correctly so that the LLVM ModuleVerifier doesn't come
         ;down like a hammer on what we're doing
         (object-pattern-match-delay
           (llvm-replace-all-uses ?ptr ?nPtr)
           (modify-instance ?bb (UnlinkedInstructions $?rest))
           (llvm-unlink-and-delete-instruction ?ptr)
           (unmake-instance ?instruction)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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-advance-init::MoveContentsToDeleteNodes
         "Moves blocks out of the contents into the closed list"
         (declare (salience 2701))
         ?wave <- (object (is-a Wavefront)
                          (id ?z)
                          (parent ?r)
                          (contents $?c)
                          (Closed $?cl))
         (test (or (> (length$ ?c) 0)
                   (> (length$ ?cl) 0)))
         =>
         (slot-insert$ ?wave DeleteNodes 1 ?c ?cl))
;------------------------------------------------------------------------------
(defrule wavefront-schedule-advance-identify::MarkShouldStayOnWavefront
         (declare (salience 343))
         ?wave <- (object (is-a Wavefront)
                          (id ?q)
                          (parent ?r)
                          (DeleteNodes $?a ?b $?c)
                          (Closed $?clos)
                          (contents $?contents))

         ?bb <- (object (is-a Diplomat)
                        (id ?b)
                        (NextPathElements ?s))
         (object (is-a Diplomat)
                 (id ?s)
                 (PreviousPathElements $?ppe))
         (test (not (subsetp ?ppe (create$ ?a ?b ?c))))
         ?agObj <- (object (is-a PathAggregate)
                           (parent ?b))
         =>
         (object-pattern-match-delay
           (if (not (member$ ?b $?clos)) then
             (bind ?ind (member$ ?b $?contents))
             (slot-delete$ ?wave Contents ?ind ?ind)
             (modify-instance ?wave (Closed $?clos ?b)
                              (DeleteNodes $?a $?c))
             else
             (modify-instance ?wave (DeleteNodes $?a $?c)))))
;------------------------------------------------------------------------------
(defrule wavefront-schedule-advance::DeleteElementFromWavefront
         (declare (salience 180))
         ?wave <- (object (is-a Wavefront)
                          (id ?id)
                          (parent ?r)
                          (DeleteNodes ?a $?))
         (object (is-a Diplomat)
                 (id ?a)
                 (NextPathElements $?npe))
         =>
         ;TODO: Continue to port here
         (object-pattern-match-delay
           (bind ?ind (member$ ?a (send ?wave get-Contents)))
           (bind ?ind2 (member$ ?a (send ?wave get-Closed)))
           (slot-delete$ ?wave DeleteNodes 1 1)
           (if ?ind then (slot-delete$ ?wave Contents ?ind ?ind))
           (if ?ind2 then (slot-delete$ ?wave Closed ?ind2 ?ind2))
           (assert (Add into ?id blocks $?npe))))
;------------------------------------------------------------------------------
(defrule PutSuccessorsOntoWavefront-Match
         (declare (salience 100))
         (Stage WavefrontSchedule $?)
         (Substage AdvanceEnd $?)
         ?fct <- (Add into ?id blocks ?next $?rest)
         ?wave <- (object (is-a Wavefront) (ID ?id))
         =>
         (retract ?fct)
         ;I know that this is procedural but I really want to get this done
         (assert (Add into ?id blocks $?rest))
         (if (not (member$ ?next (send ?wave get-Contents))) then
           (slot-insert$ ?wave Contents 1 ?next)))
;------------------------------------------------------------------------------
(defrule PutSuccessorsOntoWavefront-NoMoreElements
         (declare (salience 100))
         (Stage WavefrontSchedule $?)
         (Substage AdvanceEnd $?)
         ?fct <- (Add into ? blocks)
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-update::PonderRestartOfWavefrontScheduling
         ?fct <- (message (to wavefront-scheduling-update)
                          (from pipeline)
                          (action initial-fact))
         ?obj <- (object (is-a pass-description)
                         (passes $?passes))
         =>
         (retract ?fct)
         (bind ?instances (find-all-instances ((?wave Wavefront))
                                              (> (length$ ?wave:contents) 0)))
         (if (> (length$ ?instances) 0) then
           (modify-instance ?obj
                            (passes wavefront-scheduling-init
                                    wavefront-scheduling-identify
                                    wavefront-scheduling-phi-identify
                                    wavefront-scheduling-phi-node
                                    wavefront-scheduling-phi-node-update
                                    wavefront-scheduling-pathing
                                    wavefront-scheduling-strip
                                    wavefront-scheduling-inject
                                    wavefront-scheduling-acquire
                                    wavefront-scheduling-slice
                                    wavefront-scheduling-analyze-init
                                    wavefront-scheduling-pre-generate-analyze
                                    wavefront-scheduling-generate-analyze
                                    wavefront-scheduling-analyze
                                    wavefront-scheduling-slice-analyze
                                    wavefront-scheduling-merge-init
                                    wavefront-scheduling-merge
                                    wavefront-scheduling-merge-update
                                    wavefront-scheduling-reopen-blocks
                                    wavefront-scheduling-ponder
                                    wavefront-scheduling-post-ponder
                                    wavefront-scheduling-rename
                                    wavefront-scheduling-dependency-analysis
                                    wavefront-scheduling-advance-init
                                    wavefront-scheduling-advance-identify
                                    wavefront-scheduling-advance
                                    wavefront-scheduling-advance-end
                                    wavefront-scheduling-update
                                    $?passes))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-final::RetractUnlinkedInstructions
         ?bb <- (object (is-a BasicBlock)
                        (id ?b)
                        (UnlinkedInstructions ?i $?rest))
         ?instruction <- (object (is-a Instruction)
                                 (id ?i)
                                 (parent ?b)
                                 (pointer ?ptr))
         (object (is-a PathAggregate)
                 (parent ?b)
                 (InstructionPropagation $? ?i ?new ?b ! $?))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         =>
         ;this is a little gross but it is a very easy way to ensure that
         ;things work correctly so that the LLVM ModuleVerifier doesn't come
         ;down like a hammer on what we're doing
         (object-pattern-match-delay
           (llvm-replace-all-uses ?ptr ?nPtr)
           (modify-instance ?bb (UnlinkedInstructions $?rest))
           (llvm-unlink-and-delete-instruction ?ptr)
           (unmake-instance ?instruction)))
;------------------------------------------------------------------------------


Added support for printing out the many different constant checks

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLConstantConversion.clp - an expert system that reads a define and generates
; conversion code for it.
;------------------------------------------------------------------------------
(defmodule types
           (export ?ALL))
;------------------------------------------------------------------------------
(defmodule read-input
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule modify-input
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule identify-lines
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule convert-templates
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule build-groups
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule grouping-update
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule MAIN
           (import types ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
(defclass types::opened-file
  (is-a USER)
  (slot id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(defclass types::file-line
  (is-a USER)
  (slot id)
  (slot index)
  (slot parent)
  (slot type)
  (multislot contents))
;------------------------------------------------------------------------------
(defmessage-handler types::file-line init after ()
                    (bind ?self:id (instance-name-to-symbol (instance-name ?self))))
;------------------------------------------------------------------------------
(deftemplate types::heading-span
             "Defines a span between two different headings"
             (slot header-name)
             (multislot contents)
             (slot from)
             (slot to)
             (slot parent)
             (slot distance))
;------------------------------------------------------------------------------
(deftemplate types::message
             (slot from)
             (slot to)
             (slot action)
             (multislot arguments))
;------------------------------------------------------------------------------
(defclass types::grouping
  (is-a USER)
  (slot group-name)
  (slot parent)
  (slot from (type INTEGER) (range 0 ?VARIABLE))
  (slot to (type INTEGER) (range 0 ?VARIABLE))
  (multislot contents))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction types::get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule MAIN::open-target-file
         "This rule takes a fact of the above INPUT FORM and attempts to open the file"
         ?fct <- (parse constant file ?path)
         =>
         (bind ?name (gensym*))
         (retract ?fct)
         (if (open ?path ?name "r") then
           (make-instance of opened-file (id ?name) (index 0))
           (assert (message (to identify-lines)
                            (action read-file)
                            (arguments ?name)))
           (focus read-input
            modify-input
                  identify-lines
                  convert-templates
                  build-groups
                  grouping-update)
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule read-input::build-file-line
         ?fct <- (message (to identify-lines)
                          (action read-file)
                          (arguments ?name))
         ?obj <- (object (is-a opened-file)
                         (id ?fid))
         =>
         (retract ?fct)
         (bind ?result (send ?obj read-line))
         (if (neq ?result EOF) then
           (duplicate ?fct)
           (if (neq ?result "") then
             (make-instance of file-line (index (send ?obj next-index))
                            (type UNKNOWN)
                            (parent ?fid)
                            (contents (explode$ ?result))))
           else
           (send ?obj close-file)
           (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule modify-input::identify-symbols-with-commas
         ?fct <- (object (is-a file-line)
                         (contents $?before ?symbol $?after))
         (test (and (neq 0 (str-compare (str-cat ?symbol) ","))
                    (str-index "," (str-cat ?symbol))))
         =>
         (bind ?str (if (stringp ?symbol) then ?symbol else (str-cat ?symbol)))
         (bind ?ind (str-index "," ?str))
         (bind ?p0 (sub-string 1 (- ?ind 1) ?str))
         (bind ?p1 (sub-string (+ ?ind 1) (str-length ?str) ?str))
         (modify-instance ?fct (contents $?before ?p0 , ?p1 $?after)))
;------------------------------------------------------------------------------
(defrule modify-input::identify-symbols-with-open-parens
         ?fct <- (object (is-a file-line)
                         (contents $?before ?symbol $?after))
         (test (and (neq 0 (str-compare (str-cat ?symbol) "("))
                    (str-index "(" (str-cat ?symbol))))
         =>
         (bind ?str (if (stringp ?symbol) then ?symbol else (str-cat ?symbol)))
         (bind ?ind (str-index "(" ?str))
         (bind ?p0 (sub-string 1 ?ind ?str))
         (bind ?p1 (sub-string ?ind (str-length ?str) ?str))
         (modify-instance ?fct (contents $?before ?p0 "(" ?p1 $?after)))
;------------------------------------------------------------------------------
(defrule modify-input::identify-symbols-with-close-parens
         ?fct <- (object (is-a file-line)
                         (contents $?before ?symbol&~")" $?after))
         (test (and (neq 0 (str-compare (str-cat ?symbol) ")"))
                    (str-index ")" (str-cat ?symbol))))
         =>
         (bind ?str (if (stringp ?symbol) then ?symbol else (str-cat ?symbol)))
         (bind ?ind (str-index ")" ?str))
         (bind ?p0 (sub-string 1 ?ind ?str))
         (bind ?p1 (sub-string ?ind (str-length ?str) ?str))
         (modify-instance ?fct (contents $?before ?p0 ")" ?p1 $?after)))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents /* $? */))
         =>
         (modify-instance ?f (type heading)))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-entry-line
         "Tags lines that are defines and modifies the associated contents"
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents #define ?name ?))
         =>
         (modify-instance ?f (type #define) (contents ?name)))
;------------------------------------------------------------------------------
(defrule identify-lines::merge-three-line-headers
         "Merges simple three line headings into one rule"
         ?f0 <- (object (is-a file-line)
                        (index ?i)
                        (type UNKNOWN)
                        (contents /*))
         ?f1 <- (object (is-a file-line)
                        (index ?i2&:(= ?i2 (+ ?i 1)))
                        (type UNKNOWN)
                        (contents * $?c))
         ?f2 <- (object (is-a file-line)
                        (index ?i3&:(= ?i3 (+ ?i 2)))
                        (type UNKNOWN)
                        (contents */))
         =>
         (unmake-instance ?f1 ?f2)
         (modify-instance ?f0 (contents /* $?c */)))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-glapi-calls
         "marks glapi calls"
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents GLAPI $? "(" $? ")"))
         =>
         (modify-instance ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule identify-lines::merge-potential-glapi-calls
         "Merges the next line of a GLAPI call if the line doesn't end with )"
         (declare (salience -1))
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents GLAPI $?vals "(" $?c)
                       (index ?i))
         (test (not (member$ ")" $?c)))
         ?f0 <- (object (is-a file-line)
                        (index ?i0&:(= ?i0 (+ ?i 1)))
                        (type UNKNOWN)
                        (contents $?contents))
         =>
         (unmake-instance ?f)
         (modify-instance ?f0 (contents GLAPI $?vals "(" $?c $?contents)))
;------------------------------------------------------------------------------
(defrule identify-lines::define-header-spans-initial
         "Defines spans between headers"
         (declare (salience -3))
         (object (is-a file-line)
                 (type heading)
                 (parent ?parent)
                 (index ?i)
                 (contents /* $?name */))
         (not (exists (heading-span (from ?i)
                                    (parent ?parent))))
         (object (is-a file-line)
                 (type heading)
                 (parent ?parent)
                 (index ?i2&:(> ?i2 ?i)))
         =>
         (bind ?difference (- ?i2 ?i))
         (if (> ?difference 0) then
           (assert (heading-span (header-name (implode$ $?name))
                                 (from ?i)
                                 (to ?i2)
                                 (parent ?parent)
                                 (distance ?difference)))))
;------------------------------------------------------------------------------
(defrule identify-lines::modify-header-spans-for-smaller-size
         "Retracts the heading-span in response to finding an earlier heading"
         ?f <- (heading-span (from ?i)
                             (to ?j)
                             (parent ?parent))
         (object (is-a file-line)
                 (type heading)
                 (parent ?parent)
                 (index ?i2&:(> ?j ?i2 ?i)))
         =>
         (modify ?f (to ?i2)
                 (distance (- ?i2 ?i))))
;------------------------------------------------------------------------------
(defrule convert-templates::retract-unknowns
         ?f <- (object (is-a file-line)
                       (type UNKNOWN))
         =>
         (unmake-instance ?f))
;------------------------------------------------------------------------------
(defrule convert-templates::assert-build-groups
         ?f <- (object (is-a file-line)
                       (type ~UNKNOWN)
                       (id ?id))
         =>
         (assert (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))))
;------------------------------------------------------------------------------
(defrule build-groups::build-grouping
         ?f <- (heading-span (from ?i)
                             (to ?i2)
                             (parent ?parent)
                             (contents $?c))
         (object (is-a file-line)
                 (parent ?parent)
                 (index ?loc&:(> ?i2 ?loc ?i))
                 (id ?id))
         ?msg <- (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))
         =>
         (retract ?msg)
         (modify ?f (contents $?c ?id)))
;------------------------------------------------------------------------------
(defrule build-groups::delete-still-existing-elements
         (declare (salience -100))
         ?msg <- (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))
         ?obj <- (object (is-a file-line)
                         (id ?id))
         =>
         (unmake-instance ?obj)
         (retract ?msg))
;------------------------------------------------------------------------------
(defrule grouping-update::generate-constant-if-statement
         (heading-span (header-name ?group)
          (contents $? ?name $?))
         ?obj <- (object (is-a file-line)
                         (id ?name)
                         (type #define)
                         (contents ?element))
         =>
         (bind ?str (str-cat ?element))
         (printout t (format nil "//%s" ?group) crlf
          (format nil "if(strcmp(input,\"%s\")) { return %s; }"
           (sub-string (+ (str-index "_" ?str) 1) (str-length ?str) ?str)
          ?element) crlf crlf))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLConstantConversion.clp - an expert system that reads a define and generates
; conversion code for it.
;------------------------------------------------------------------------------
(defmodule types
           (export ?ALL))
;------------------------------------------------------------------------------
(defmodule read-input
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule modify-input
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule identify-lines
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule convert-templates
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule build-groups
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule grouping-update
           (import types ?ALL))
;------------------------------------------------------------------------------
(defmodule MAIN
           (import types ?ALL)
           (export ?ALL))
;------------------------------------------------------------------------------
(defclass types::opened-file
  (is-a USER)
  (slot id)
  (slot index (type INTEGER) (range 0 ?VARIABLE))
  (message-handler next-index)
  (message-handler read-line)
  (message-handler close-file))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file next-index ()
                    (bind ?old ?self:index)
                    (bind ?self:index (+ ?old 1))
                    (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file read-line ()
                    (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler types::opened-file close-file ()
                    (close ?self:id))
;------------------------------------------------------------------------------
(defclass types::file-line
  (is-a USER)
  (slot id)
  (slot index)
  (slot parent)
  (slot type)
  (multislot contents))
;------------------------------------------------------------------------------
(defmessage-handler types::file-line init after ()
                    (bind ?self:id (instance-name-to-symbol (instance-name ?self))))
;------------------------------------------------------------------------------
(deftemplate types::heading-span
             "Defines a span between two different headings"
             (slot header-name)
             (multislot contents)
             (slot from)
             (slot to)
             (slot parent)
             (slot distance))
;------------------------------------------------------------------------------
(deftemplate types::message
             (slot from)
             (slot to)
             (slot action)
             (multislot arguments))
;------------------------------------------------------------------------------
(defclass types::grouping
  (is-a USER)
  (slot group-name)
  (slot parent)
  (slot from (type INTEGER) (range 0 ?VARIABLE))
  (slot to (type INTEGER) (range 0 ?VARIABLE))
  (multislot contents))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction types::get-input-form-factor ()
             (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule MAIN::open-target-file
         "This rule takes a fact of the above INPUT FORM and attempts to open the file"
         ?fct <- (parse constant file ?path)
         =>
         (bind ?name (gensym*))
         (retract ?fct)
         (if (open ?path ?name "r") then
           (make-instance of opened-file (id ?name) (index 0))
           (assert (message (to identify-lines)
                            (action read-file)
                            (arguments ?name)))
           (focus read-input
            modify-input
                  identify-lines
                  convert-templates
                  build-groups
                  grouping-update)
           else
           (printout t "ERROR: target file at " ?path " does not exist!" crlf
                     "Halting!" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule read-input::build-file-line
         ?fct <- (message (to identify-lines)
                          (action read-file)
                          (arguments ?name))
         ?obj <- (object (is-a opened-file)
                         (id ?fid))
         =>
         (retract ?fct)
         (bind ?result (send ?obj read-line))
         (if (neq ?result EOF) then
           (duplicate ?fct)
           (if (neq ?result "") then
             (make-instance of file-line (index (send ?obj next-index))
                            (type UNKNOWN)
                            (parent ?fid)
                            (contents (explode$ ?result))))
           else
           (send ?obj close-file)
           (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule modify-input::identify-symbols-with-commas
         ?fct <- (object (is-a file-line)
                         (contents $?before ?symbol $?after))
         (test (and (neq 0 (str-compare (str-cat ?symbol) ","))
                    (str-index "," (str-cat ?symbol))))
         =>
         (bind ?str (if (stringp ?symbol) then ?symbol else (str-cat ?symbol)))
         (bind ?ind (str-index "," ?str))
         (bind ?p0 (sub-string 1 (- ?ind 1) ?str))
         (bind ?p1 (sub-string (+ ?ind 1) (str-length ?str) ?str))
         (modify-instance ?fct (contents $?before ?p0 , ?p1 $?after)))
;------------------------------------------------------------------------------
(defrule modify-input::identify-symbols-with-open-parens
         ?fct <- (object (is-a file-line)
                         (contents $?before ?symbol $?after))
         (test (and (neq 0 (str-compare (str-cat ?symbol) "("))
                    (str-index "(" (str-cat ?symbol))))
         =>
         (bind ?str (if (stringp ?symbol) then ?symbol else (str-cat ?symbol)))
         (bind ?ind (str-index "(" ?str))
         (bind ?p0 (sub-string 1 ?ind ?str))
         (bind ?p1 (sub-string ?ind (str-length ?str) ?str))
         (modify-instance ?fct (contents $?before ?p0 "(" ?p1 $?after)))
;------------------------------------------------------------------------------
(defrule modify-input::identify-symbols-with-close-parens
         ?fct <- (object (is-a file-line)
                         (contents $?before ?symbol&~")" $?after))
         (test (and (neq 0 (str-compare (str-cat ?symbol) ")"))
                    (str-index ")" (str-cat ?symbol))))
         =>
         (bind ?str (if (stringp ?symbol) then ?symbol else (str-cat ?symbol)))
         (bind ?ind (str-index ")" ?str))
         (bind ?p0 (sub-string 1 ?ind ?str))
         (bind ?p1 (sub-string ?ind (str-length ?str) ?str))
         (modify-instance ?fct (contents $?before ?p0 ")" ?p1 $?after)))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-heading-groups
         "Tags lines that consist of /* $? */ as group headings"
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents /* $? */))
         =>
         (modify-instance ?f (type heading)))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-entry-line
         "Tags lines that are defines and modifies the associated contents"
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents #define ?name ?))
         =>
         (modify-instance ?f (type #define) (contents ?name)))
;------------------------------------------------------------------------------
(defrule identify-lines::merge-three-line-headers
         "Merges simple three line headings into one rule"
         ?f0 <- (object (is-a file-line)
                        (index ?i)
                        (type UNKNOWN)
                        (contents /*))
         ?f1 <- (object (is-a file-line)
                        (index ?i2&:(= ?i2 (+ ?i 1)))
                        (type UNKNOWN)
                        (contents * $?c))
         ?f2 <- (object (is-a file-line)
                        (index ?i3&:(= ?i3 (+ ?i 2)))
                        (type UNKNOWN)
                        (contents */))
         =>
         (unmake-instance ?f1 ?f2)
         (modify-instance ?f0 (contents /* $?c */)))
;------------------------------------------------------------------------------
(defrule identify-lines::mark-glapi-calls
         "marks glapi calls"
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents GLAPI $? "(" $? ")"))
         =>
         (modify-instance ?f (type GLAPI-DEF)))
;------------------------------------------------------------------------------
(defrule identify-lines::merge-potential-glapi-calls
         "Merges the next line of a GLAPI call if the line doesn't end with )"
         (declare (salience -1))
         ?f <- (object (is-a file-line)
                       (type UNKNOWN)
                       (contents GLAPI $?vals "(" $?c)
                       (index ?i))
         (test (not (member$ ")" $?c)))
         ?f0 <- (object (is-a file-line)
                        (index ?i0&:(= ?i0 (+ ?i 1)))
                        (type UNKNOWN)
                        (contents $?contents))
         =>
         (unmake-instance ?f)
         (modify-instance ?f0 (contents GLAPI $?vals "(" $?c $?contents)))
;------------------------------------------------------------------------------
(defrule identify-lines::define-header-spans-initial
         "Defines spans between headers"
         (declare (salience -3))
         (object (is-a file-line)
                 (type heading)
                 (parent ?parent)
                 (index ?i)
                 (contents /* $?name */))
         (not (exists (heading-span (from ?i)
                                    (parent ?parent))))
         (object (is-a file-line)
                 (type heading)
                 (parent ?parent)
                 (index ?i2&:(> ?i2 ?i)))
         =>
         (bind ?difference (- ?i2 ?i))
         (if (> ?difference 0) then
           (assert (heading-span (header-name (implode$ $?name))
                                 (from ?i)
                                 (to ?i2)
                                 (parent ?parent)
                                 (distance ?difference)))))
;------------------------------------------------------------------------------
(defrule identify-lines::modify-header-spans-for-smaller-size
         "Retracts the heading-span in response to finding an earlier heading"
         ?f <- (heading-span (from ?i)
                             (to ?j)
                             (parent ?parent))
         (object (is-a file-line)
                 (type heading)
                 (parent ?parent)
                 (index ?i2&:(> ?j ?i2 ?i)))
         =>
         (modify ?f (to ?i2)
                 (distance (- ?i2 ?i))))
;------------------------------------------------------------------------------
(defrule convert-templates::retract-unknowns
         ?f <- (object (is-a file-line)
                       (type UNKNOWN))
         =>
         (unmake-instance ?f))
;------------------------------------------------------------------------------
(defrule convert-templates::assert-build-groups
         ?f <- (object (is-a file-line)
                       (type ~UNKNOWN)
                       (id ?id))
         =>
         (assert (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))))
;------------------------------------------------------------------------------
(defrule build-groups::build-grouping
         ?f <- (heading-span (from ?i)
                             (to ?i2)
                             (parent ?parent)
                             (contents $?c))
         (object (is-a file-line)
                 (parent ?parent)
                 (index ?loc&:(> ?i2 ?loc ?i))
                 (id ?id))
         ?msg <- (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))
         =>
         (retract ?msg)
         (modify ?f (contents $?c ?id)))
;------------------------------------------------------------------------------
(defrule build-groups::delete-still-existing-elements
         (declare (salience -100))
         ?msg <- (message (to build-groups)
                          (action add-to-span)
                          (arguments ?id))
         ?obj <- (object (is-a file-line)
                         (id ?id))
         =>
         (unmake-instance ?obj)
         (retract ?msg))
;------------------------------------------------------------------------------
;(defrule grouping-update::


Create task2.clp

Create task2.clp

;Get string, replace all spaces by "_"
(defrule replace
 =>
 (bind ?str (readline))
 (bind ?a " ")
 (bind ?b "_")
 (bind ?n (str-length ?str))
 (bind ?res "")
 (loop-for-count (?i 1 ?n) do
    (bind ?c1 (sub-string ?i ?i ?str))
    (bind ?d (str-compare ?c1 ?a))

    (if (= ?d 0) then
        (bind ?res (str-cat ?res ?b)))

    (if (<> ?d 0) then
        (bind ?res (str-cat ?res ?c1))))

 (printout t "result=" ?res crlf)
 )

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


Added the ModuleHeader for the core module

This file acts as the entry point to the module

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; ModuleHeader.clp - Contains the entry point into the core module.
;------------------------------------------------------------------------------
; In CLIPS, modules are defined BEFORE their corresponding contents are defined
; so this file doubles as a loader as well. Absolute paths must be used because
; CLIPS does not understand the concept of partial paths.
;
; If you want to change the layout of this module then you must update these
; paths. Failure to do so will cause the optimization to not work correctly.
;------------------------------------------------------------------------------

(defmodule core
 ; Modify this export to add more classes
 ; Just remember that these three classes are pretty critical to the rest of
 ; the optimization
 (export defclass Object InteropObject Hint)
 ; Modify this export to add more functions to be exposed
 ; I would advise against removing these functions
 (export deffunction superset equal$ has-common-element disjoint)

(load* "modules/core/Object.clp")
(load* "modules/core/InteropObject.clp")
(load* "modules/core/Hint.clp")
; Add more defclasses here
; The programmer is responsible for ordering the load statements so that
; class dependencies are met
(load* "modules/core/SetExtensions.clp")
; Add more deffunctions here
; The programmer is responsible for ordering the load statements so that
; function dependencies are met

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


Added a load statement for LLVMType into the llvm module header

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; ModuleHeader.clp - Contains the entry point into the llvm module.
;------------------------------------------------------------------------------
; In CLIPS, modules are defined BEFORE their corresponding contents are defined
; so this file doubles as a loader as well. Absolute paths must be used because
; CLIPS does not understand the concept of partial paths.
;
; If you want to change the layout of this module then you must update these
; paths. Failure to do so will cause the optimization to not work correctly.
;------------------------------------------------------------------------------

; Path is modules/llvm/
(defmodule llvm
 (import core defclass ?ALL)
 (import core deffunction ?ALL)
 (export defclass ?ALL)
 (export deffunction ?ALL))

; DO NOT MESS WITH THE ORDER OF THESE COMMANDS
; BAD THINGS CAN HAPPEN
; Class loaders
(load* "modules/llvm/LLVMObject.clp")
(load* "modules/llvm/LLVMType.clp")
(load* "modules/llvm/LLVMValue.clp")
(load* "modules/llvm/LLVMUser.clp")
(load* "modules/llvm/Diplomat.clp")

; Function loaders

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; ModuleHeader.clp - Contains the entry point into the llvm module.
;------------------------------------------------------------------------------
; In CLIPS, modules are defined BEFORE their corresponding contents are defined
; so this file doubles as a loader as well. Absolute paths must be used because
; CLIPS does not understand the concept of partial paths.
;
; If you want to change the layout of this module then you must update these
; paths. Failure to do so will cause the optimization to not work correctly.
;------------------------------------------------------------------------------

; Path is modules/llvm/
(defmodule llvm
 (import core defclass ?ALL)
 (import core deffunction ?ALL)
 (export defclass ?ALL)
 (export deffunction ?ALL))

; DO NOT MESS WITH THE ORDER OF THESE COMMANDS
; BAD THINGS CAN HAPPEN
; Class loaders
(load* "modules/llvm/LLVMObject.clp")
(load* "modules/llvm/LLVMValue.clp")
(load* "modules/llvm/LLVMUser.clp")
(load* "modules/llvm/Diplomat.clp")

; Function loaders