WidgetElement.clp: Added support for raising and registering 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))
  (slot width (type NUMBER))
  (slot height (type NUMBER))
  (slot reference-count (type NUMBER) (range 0 ?VARIABLE))
  (multislot children (type SYMBOL))
  (multislot valid-events (type SYMBOL))
  (message-handler declare-handler primary)
  (message-handler raise-event primary))
;------------------------------------------------------------------------------
(defmessage-handler widget::WidgetElement declare-handler primary
                    (?name ?fn)
                    (bind ?we-name (gensym*))
                    (make-instance ?we-name of WidgetEvent
                                   (event-name ?name)
                                   (function-to-call ?fn)
                                   (parent ?self:id)
                                   (reference-count 1))
                    (bind ?result (member$ ?name ?self:valid-events))
                    (if (not ?result) then
                      (slot-direct-insert$ valid-events 1 ?name ?we-name )
                      else
                      (printout werror "ERROR: Firing of multiple events not supported yet"  crlf)
                      (halt))
                    (return ?we-name))
;------------------------------------------------------------------------------
(defmessage-handler widget::WidgetElement raise-event primary
                    (?name $?args)
                    (bind ?offset (member$ ?name ?self:valid-events))
                    (if (not ?offset) then
                      (printout werror "ERROR: given event " ?name
                                " does not exist. Halting" crlf)
                      (halt)
                      else
                      (send (instance-address * (symbol-to-instance-name
                                                  (nth$ (+ 1 ?offset)
                                                        ?self:valid-events)))
                            raise-event $?args)))
;------------------------------------------------------------------------------

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


Added the post-ponder module

Added the post-ponder module

This module executes marks blocks as closed on the wavefront. This divergence
from the original code was necessary because the modification of next pass set
requires that we get back to the pipeline first. In the original code, the
changing of the substage fact would preclude execution of
FinishedSchedulingIntoBlock. However, in the module version it is necessary to
push FinishedSchedulingIntoBlock into its own module instead.

;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.
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-identify
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-pathing
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-phi-identify
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-phi-node
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-phi-node-update
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-strip
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-acquire
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-inject
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-acquire
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-slice
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-analyze-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-pre-generate-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-generate-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-slice-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-merge-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-merge
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-merge-update
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-reopen-blocks
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-ponder
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-rename
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-dependency-analysis
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance-identify
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance-end
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-update
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-post-ponder
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-code::macro-expand
         ?msg <- (message (from pipeline)
                          (to wavefront-scheduling-code)
                          (action initial-fact))
         ?p <- (object (is-a pass-description) (passes $?passes))
         =>
         (retract ?msg)
         (modify-instance ?p (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
                               ;TODO: add more modules
                               $?passes)))
;------------------------------------------------------------------------------
(load* "Stages/Wavefront/WavefrontInitialization.clp")
(load* "Stages/Wavefront/ValidBlockIdentification.clp")
(load* "Stages/Wavefront/WavefrontScheduling.clp")
(load* "Stages/Wavefront/WavefrontPropagation.clp")
(load* "Stages/Wavefront/WavefrontAdvancement.clp")
(load* "Stages/Wavefront/WavefrontDependencyUpdate.clp")
(load* "Stages/Wavefront/WavefrontOperandRename.clp")
(load* "Stages/Wavefront/WavefrontInstructionMerging.clp")
(load* "Stages/Wavefront/WavefrontBlockReopen.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.
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-identify
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-pathing
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-phi-identify
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-phi-node
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-phi-node-update
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-strip
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-acquire
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-inject
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-acquire
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-slice
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-analyze-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-pre-generate-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-generate-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-slice-analyze
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-merge-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-merge
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-merge-update
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-reopen-blocks
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-ponder
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-rename
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-dependency-analysis
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance-init
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance-identify
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-advance-end
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-update
           (import core ?ALL)
           (import llvm ?ALL)
           (import types ?ALL)
           (import pipeline ?ALL)
           (import indirect ?ALL)
           (import rampancy ?ALL)
           (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-code::macro-expand
         ?msg <- (message (from pipeline)
                          (to wavefront-scheduling-code)
                          (action initial-fact))
         ?p <- (object (is-a pass-description) (passes $?passes))
         =>
         (retract ?msg)
         (modify-instance ?p (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-rename
                               wavefront-scheduling-dependency-analysis
                               wavefront-scheduling-advance-init
                               wavefront-scheduling-advance-identify
                               wavefront-scheduling-advance
                               wavefront-scheduling-advance-end
                               wavefront-scheduling-update
                               ;TODO: add more modules
                               $?passes)))
;------------------------------------------------------------------------------
(load* "Stages/Wavefront/WavefrontInitialization.clp")
(load* "Stages/Wavefront/ValidBlockIdentification.clp")
(load* "Stages/Wavefront/WavefrontScheduling.clp")
(load* "Stages/Wavefront/WavefrontPropagation.clp")
(load* "Stages/Wavefront/WavefrontAdvancement.clp")
(load* "Stages/Wavefront/WavefrontDependencyUpdate.clp")
(load* "Stages/Wavefront/WavefrontOperandRename.clp")
(load* "Stages/Wavefront/WavefrontInstructionMerging.clp")
(load* "Stages/Wavefront/WavefrontBlockReopen.clp")


Updated the pass manager to define wavefront-scheduling

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

(definstances PersistentPassRegistry
 ([test] of Pass
  (entry-point "passes/test/PassHeader.clp")
  (pass-name test)
  (pass-description "A test of the indirect pass system")
  (pass-type Module)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes test)
  (required loops regions)
  (preserves-cfg TRUE)
  (preserves-all TRUE))
 ([paths] of Pass
  (entry-point "passes/path/all/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))
 ([paths-conditional] of Pass
  (entry-point "passes/path/conditional/PassHeader.clp")
  (pass-name paths-conditional)
  (pass-description "Generate the set of paths through a set of target regions")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths-conditional)
  (required loops regions))
 ([loop-region-merging] of Pass
  (entry-point "passes/loop-region-merging/PassHeader.clp")
  (pass-name loop-region-merging)
  (pass-description "Merges the loops and regions of a given function into a single logical CFG.")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes loop-region-merging)
  (required loops regions))
 ([dependency-analysis] of Pass
  (entry-point "passes/dependency-analysis/PassHeader.clp")
  (pass-name dependency-analysis)
  (pass-description "Performs dependency analysis between instructions in a function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes dependency-analysis)
  (required loops regions))
 ([wavefront-scheduling] of Pass
  (entry-point "passes/wavefront-scheduling/PassHeader.clp")
  (pass-name wavefront-scheduling)
  (pass-description "Performs wavefront scheduling on a target function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes wavefront-scheduling)
  (required loops regions))
 ;Add more passes here
)
;------------------------------------------------------------------------------

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

(definstances PersistentPassRegistry
 ([test] of Pass
  (entry-point "passes/test/PassHeader.clp")
  (pass-name test)
  (pass-description "A test of the indirect pass system")
  (pass-type Module)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes test)
  (required loops regions)
  (preserves-cfg TRUE)
  (preserves-all TRUE))
 ([paths] of Pass
  (entry-point "passes/path/all/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))
 ([paths-conditional] of Pass
  (entry-point "passes/path/conditional/PassHeader.clp")
  (pass-name paths-conditional)
  (pass-description "Generate the set of paths through a set of target regions")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths-conditional)
  (required loops regions))
 ([loop-region-merging] of Pass
  (entry-point "passes/loop-region-merging/PassHeader.clp")
  (pass-name loop-region-merging)
  (pass-description "Merges the loops and regions of a given function into a single logical CFG.")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes loop-region-merging)
  (required loops regions))
 ([dependency-analysis] of Pass
  (entry-point "passes/dependency-analysis/PassHeader.clp")
  (pass-name dependency-analysis)
  (pass-description "Performs dependency analysis between instructions in a function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes dependency-analysis)
  (required loops regions))

 ;Add more passes here
)
;------------------------------------------------------------------------------


Updated DeclareLogicFunctions to use generic-load

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; DeclareLogicFunctions.clp - Defines functions to load code from the
; logic folder
;
; Written by Joshua Scoggins
; Started on 3/13/2013
;------------------------------------------------------------------------------
(defgeneric init::load-logic)
;------------------------------------------------------------------------------
(defgeneric init::logic-files)
;------------------------------------------------------------------------------
(defmethod init::load-logic
             "Loads logic/<folder-name>/Entry.clp."
             ((?folder-name LEXEME))
             (generic-load logic ?folder-name Entry.clp))
;------------------------------------------------------------------------------
(defmethod init::logic-files
             "Loads a series of logic files from the specified path"
             ((?offset LEXEME)
              ($?files LEXEME))
             (generic-load logic ?offset ?files))
;------------------------------------------------------------------------------
(defmethod init::logic-files
             "Loads a series of logic files from the specified path"
             ((?offset LEXEME)
              (?files LEXEME MULTIFIELD))
             (generic-load logic ?offset ?files))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; DeclareLogicFunctions.clp - Defines functions to load code from the
; logic folder
;
; Written by Joshua Scoggins
; Started on 3/13/2013
;------------------------------------------------------------------------------
(deffunction init::load-logic
             "Loads logic/<folder-name>/Entry.clp."
             (?folder-name)
             (batch* (format nil "logic/%s/Entry.clp" ?folder-name)))
;------------------------------------------------------------------------------
(deffunction init::logic-files
             "Loads a series of logic files from the specified path"
             (?offset $?files)
             (bind ?coreOffset (format nil "logic/%s/%s" ?offset "%s"))
             (progn$ (?a $?files)
                     (batch* (format nil ?coreOffset ?a))))
;------------------------------------------------------------------------------


Fixed bugs in GLAPIConversion prototype expert system

I fixed the issue with the argument splitting where the positions of some
arguments were being incorrectly calcluated

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLAPIConversion.clp - an expert system that reads a define and generates
; corresponding CLIPS functions that convert the CLIPS values into
; corresponding opengl types. This gets a little goofy when dealing with
; multifields but the idea is sound.
;------------------------------------------------------------------------------
; We need to add functionality to diverge asterisks from a symbol
;------------------------------------------------------------------------------
(target-symbol-is-special "*"
								  identify-symbols-with-asterisks
								  "Splits asterisks (*) out of symbols if necessary")
;------------------------------------------------------------------------------
; Can't escape with double quotes with ] and [...strange
;------------------------------------------------------------------------------
(target-symbol-is-special "["
								  identify-symbols-with-open-square-bracket
								  "Splits an input string on [")
;------------------------------------------------------------------------------
(target-symbol-is-special "]"
								  identify-symbols-with-close-square-bracket
								  "Splits an input string on ]")
;------------------------------------------------------------------------------
; Unlike GLConstantConversion, I don't need to use the heading span objects.
; This is because each file-line has already been correctly merged.
;------------------------------------------------------------------------------
(defrule build-groups::delete-heading-span
			"We don't need heading spans in this expert system. So delete them"
			?obj <- (object (is-a heading-span))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------
; We need to define a transformation function/rule f which is responsible for
; taking in a knowledge representation of the original code from the input
; language and translates it to a knowledge representation of the code in the
; output language. In this case it is C => C with the added "benefit" of
; needing to add CLIPS api calls to interact with the overall environment.
;
; This isn't really that hard as what we need to do is just parse the arguments
; and generate the corresponding C code.
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type (visibility public))
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
						  ()
						  (return (format nil "%s %s %s %s"
												(if ?self:is-constant then "const" else "")
												?self:argument-type
												(if ?self:is-pointer then "*" else "")
												?self:argument-name)))
;------------------------------------------------------------------------------
(defclass types::GLAPIFixedArrayArgument
  "Refers to fixed size arrays"
  (is-a GLAPIArgument)
  (slot array-size)
  (message-handler reconstitute around))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFixedArrayArgument reconstitute around
						  ()
						  (return (format nil "%s[%s]"
												(call-next-handler)
												(str-cat ?self:array-size))))
;------------------------------------------------------------------------------
; build-groups module
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" $?args ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(modify ?msg
					  (action parse-arguments)
					  (arguments ?objName => $?args))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function-void
			(declare (salience 1))
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" void ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(retract ?msg)
			(make-instance of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(deffunction build-groups::count-commas
				 "Iterates through a multifield and counts the number of commas"
				 (?list)
				 (bind ?count 0)
				 (progn$ (?e ?list)
							(if (or (eq ?e ",")
									  (eq ?e ,)) then
							  (bind ?count (+ 1 ?count))))
				 (return ?count))
;------------------------------------------------------------------------------
(defrule build-groups::concatentate-length
			"Adds a range to the target argument set"
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ?o => $?contents))
			=>
			(modify ?fct (action diverge-arguments)
					  (arguments ?o 0 (count-commas $?contents) =>
									 $?contents)))
;------------------------------------------------------------------------------
(defrule build-groups::diverge-arguments
			"Splits the set of arguments into two separate facts"
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?start ?finish => $?a "," $?b))
			(test (neq ?start ?finish))
			=>
			(bind ?cca (count-commas $?a))
			(bind ?starta ?start)
			(bind ?enda (+ ?starta ?cca))
			;from start to end
			(bind ?startb (+ 1 ?enda))
			;we use finish since it's the upper bound on this argument set
			(bind ?endb ?finish)
         (modify ?fct (arguments ?o ?starta ?enda => $?a))
			(duplicate ?fct (arguments ?o ?startb ?endb => $?b)))
;------------------------------------------------------------------------------
(defrule build-groups::generate-build-argument-statement
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?pos ?pos => $?conditions))
			=>
			(modify ?fct (action build-argument)
					  (arguments ?o ?pos => $?conditions)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-fixed-array
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?field "[" ?size "]"))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?field))
			(make-instance ?name of GLAPIFixedArrayArgument
								(parent ?o)
								(array-size ?size)
								(index ?ind)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-generic
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?input))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?input))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index ?ind)))
;------------------------------------------------------------------------------
; grouping-update module
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-pointer
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before "*" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-pointer TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-constant
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before const|"const" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-constant TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-core-info
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => ?type ?name))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o =>))

			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o =>))
			(object (is-a GLAPIArgument)
					  (id ?o)
					  (parent ?p))
			=>
			(modify ?fct (action make-function-builder)
					  (arguments ?p)))
;------------------------------------------------------------------------------
(defclass types::FunctionBuilder
  "Builds C functions"
  (is-a Object)
  (multislot contents))
;------------------------------------------------------------------------------
(defrule grouping-update::make-function-builder
			?fct <- (message (to grouping-update)
								  (action make-function-builder)
								  (arguments ?p))
			=>
			(modify ?fct (action build-function)
					  (arguments ?p -1))
			(make-instance of FunctionBuilder (parent ?p)))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-header
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p -1))
			?obj <- (object (is-a FunctionBuilder)
								 (parent ?p))
			(object (is-a GLAPIFunction)
					  (id ?p)
					  (return-type ?ret)
					  (clips-function-name ?cfn))
			=>
			(modify ?fct (arguments ?p 0))
			(modify-instance ?obj (contents
											(format nil "extern %s %s(void* theEnv) {"
													  ?ret ?cfn))))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-add-argument
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			?arg <- (object (is-a GLAPIArgument)
								 (parent ?p)
								 (index ?index))
			?obj <- (object (is-a FunctionBuilder)
								 (parent ?p)
								 (contents $?contents))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(modify-instance ?obj
								  (contents $?contents
												(format nil "//code to handle %s"
														  (send ?arg reconstitute)))))
;------------------------------------------------------------------------------
(defrule grouping-update::close-function
			(declare (salience -1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			(not (exists (object (is-a GLAPIArgument)
										(parent ?p)
										(index ?index))))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?contents))
			=>
			(modify ?fct (action print-function)
					  (arguments ?p))
			(modify-instance ?f (contents $?contents "}")))
;------------------------------------------------------------------------------
(defrule grouping-update::print-built-function
			?fct <- (message (to grouping-update)
								  (action print-function)
								  (arguments ?p))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?c))
			=>
			(progn$ (?line ?c)
					  (printout t ?line crlf))
			(printout t crlf crlf)
			(retract ?fct)
			(unmake-instance ?f))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLAPIConversion.clp - an expert system that reads a define and generates
; corresponding CLIPS functions that convert the CLIPS values into
; corresponding opengl types. This gets a little goofy when dealing with
; multifields but the idea is sound.
;------------------------------------------------------------------------------
; We need to add functionality to diverge asterisks from a symbol
;------------------------------------------------------------------------------
(target-symbol-is-special "*"
								  identify-symbols-with-asterisks
								  "Splits asterisks (*) out of symbols if necessary")
;------------------------------------------------------------------------------
; Can't escape with double quotes with ] and [...strange
;------------------------------------------------------------------------------
(target-symbol-is-special "["
								  identify-symbols-with-open-square-bracket
								  "Splits an input string on [")
;------------------------------------------------------------------------------
(target-symbol-is-special "]"
								  identify-symbols-with-close-square-bracket
								  "Splits an input string on ]")
;------------------------------------------------------------------------------
; Unlike GLConstantConversion, I don't need to use the heading span objects.
; This is because each file-line has already been correctly merged.
;------------------------------------------------------------------------------
(defrule build-groups::delete-heading-span
			"We don't need heading spans in this expert system. So delete them"
			?obj <- (object (is-a heading-span))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------
; We need to define a transformation function/rule f which is responsible for
; taking in a knowledge representation of the original code from the input
; language and translates it to a knowledge representation of the code in the
; output language. In this case it is C => C with the added "benefit" of
; needing to add CLIPS api calls to interact with the overall environment.
;
; This isn't really that hard as what we need to do is just parse the arguments
; and generate the corresponding C code.
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type (visibility public))
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
						  ()
						  (return (format nil "%s %s %s %s"
												(if ?self:is-constant then "const" else "")
												?self:argument-type
												(if ?self:is-pointer then "*" else "")
												?self:argument-name)))
;------------------------------------------------------------------------------
(defclass types::GLAPIFixedArrayArgument
  "Refers to fixed size arrays"
  (is-a GLAPIArgument)
  (slot array-size)
  (message-handler reconstitute around))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFixedArrayArgument reconstitute around
						  ()
						  (return (format nil "%s[%s]"
												(call-next-handler)
												(str-cat ?self:array-size))))
;------------------------------------------------------------------------------
; build-groups module
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" $?args ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(modify ?msg
					  (action parse-arguments)
					  (arguments ?objName => $?args))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function-void
			(declare (salience 1))
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" void ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(retract ?msg)
			(make-instance of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(deffunction build-groups::count-commas
				 "Iterates through a multifield and counts the number of commas"
				 (?list)
				 (bind ?count 0)
				 (progn$ (?e ?list)
							(if (or (eq ?e ",")
									  (eq ?e ,)) then
							  (bind ?count (+ 1 ?count))))
				 (return ?count))
;------------------------------------------------------------------------------
(defrule build-groups::concatentate-length
			"Adds a range to the target argument set"
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ?o => $?contents))
			=>
			(modify ?fct (action diverge-arguments)
					  (arguments ?o 0 (count-commas $?contents) =>
									 $?contents)))
;------------------------------------------------------------------------------
(defrule build-groups::diverge-arguments
			"Splits the set of arguments into two separate facts"
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?start ?finish => $?a "," $?b))
			(test (neq ?start ?finish))
			=>
			(bind ?cca (+ ?start (count-commas $?a)))
			(bind ?startb (+ ?cca 1))
			(bind ?ccb (+ ?startb (count-commas $?b)))
			(modify ?fct (arguments ?o ?start ?cca => $?a))
			(duplicate ?fct (arguments ?o ?startb (+ ?startb ?ccb) => $?b)))
;------------------------------------------------------------------------------
(defrule build-groups::generate-build-argument-statement
			?fct <- (message (to build-groups)
								  (action diverge-arguments)
								  (arguments ?o ?pos ?pos => $?conditions))
			=>
			(modify ?fct (action build-argument)
					  (arguments ?o ?pos => $?conditions)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-fixed-array
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?field "[" ?size "]"))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?field))
			(make-instance ?name of GLAPIFixedArrayArgument
								(parent ?o)
								(array-size ?size)
								(index ?ind)))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-generic
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?ind => $?input))
			=>
			(bind ?name (gensym*))
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?input))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index ?ind)))
;------------------------------------------------------------------------------
; grouping-update module
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-pointer
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before "*" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-pointer TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-constant
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before const|"const" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-constant TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-core-info
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => ?type ?name))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o =>))

			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o =>))
			(object (is-a GLAPIArgument)
					  (id ?o)
					  (parent ?p))
			=>
			(modify ?fct (action make-function-builder)
					  (arguments ?p)))
;------------------------------------------------------------------------------
(defclass types::FunctionBuilder
  "Builds C functions"
  (is-a Object)
  (multislot contents))
;------------------------------------------------------------------------------
(defrule grouping-update::make-function-builder
			?fct <- (message (to grouping-update)
								  (action make-function-builder)
								  (arguments ?p))
			=>
			(modify ?fct (action build-function)
					  (arguments ?p -1))
			(make-instance of FunctionBuilder (parent ?p)))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-header
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p -1))
			?obj <- (object (is-a FunctionBuilder)
								 (parent ?p))
			(object (is-a GLAPIFunction)
					  (id ?p)
					  (return-type ?ret)
					  (clips-function-name ?cfn))
			=>
			(modify ?fct (arguments ?p 0))
			(modify-instance ?obj (contents
											(format nil "extern %s %s(void* theEnv) {"
													  ?ret ?cfn))))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-add-argument
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			?arg <- (object (is-a GLAPIArgument)
								 (parent ?p)
								 (index ?index))
			?obj <- (object (is-a FunctionBuilder)
								 (parent ?p)
								 (contents $?contents))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(modify-instance ?obj
								  (contents $?contents
												(format nil "//code to handle %s"
														  (send ?arg reconstitute)))))
;------------------------------------------------------------------------------
(defrule grouping-update::close-function
			(declare (salience -1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			(not (exists (object (is-a GLAPIArgument)
										(parent ?p)
										(index ?index))))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?contents))
			=>
			(modify ?fct (action print-function)
					  (arguments ?p))
			(modify-instance ?f (contents $?contents "}")))
;------------------------------------------------------------------------------
(defrule grouping-update::print-built-function
			?fct <- (message (to grouping-update)
								  (action print-function)
								  (arguments ?p))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?c))
			=>
			(progn$ (?line ?c)
					  (printout t ?line crlf))
			(printout t crlf crlf)
			(retract ?fct)
			(unmake-instance ?f))
;------------------------------------------------------------------------------


Update chapter-2.clp

Update chapter-2.clp

// First task
// Students
(deffacts students
         (student LelyakinMA 4)
         (student ArutunyaAS 4)
         (student KefalicsAI 1)
         (student BelokobylskySA 2)
)

(reset)
(facts)

(retract 2)
(retract 3)

(assert (student KefalicsAI 2))

(facts)

// Trains
(deffacts trains
          (train 11 Saratov 11)
          (train 22 Engels 21)
          (train 33 Kazan 22)
)

(reset)
(assert (train 44 Samara 10))
(assert (train 55 Volgograd 08))

(retract 1 4)

(retract 2 3)

(assert (train 22 Moscow 01))
(assert (train 33 Kazan 00))

// Employees
(assert (sotrudnik LelyakinMA 1)
        (sotrudnik GerasimovVD 2)
        (sotrudnik VonnegutKG 3)
        (sotrudnik PushkinAS 3)
)

(reset)
(retract 1)

(retract 3)
(assert (sotrudnik VasilevKD 3))

// Products
(assert (IceCream Russia 10 1)
		(ApelsineJuce Russia 20 2)
		(WaterMelone Russia 30 3)
		(Liberty USA 1000 99)
)

(reset)
(facts)

(retract 2)
(ApelsineJuce Russia 19 2)

(retract 4)
(Liberty USA 0 99)

// First task
// Students
(deffacts students
         (student LelyakinMA 4)
         (student ArutunyaAS 4)
         (student KefalicsAI 1)
         (student BelokobylskySA 2)
)

(facts)

(retract 2)
(retract 3)

(assert (student KefalicsAI 2))

(facts)

// Trains
(deffacts trains
          (train 11 Saratov 11)
          (train 22 Engels 21)
          (train 33 Kazan 22)
)

(assert (train 44 Samara 10))
(assert (train 55 Volgograd 08))

(retract 1 4)

(retract 2 3)

(assert (train 22 Moscow 01))
(assert (train 33 Kazan 00))

// Employees
(assert (sotrudnik LelyakinMA 1)
        (sotrudnik GerasimovVD 2)
        (sotrudnik VonnegutKG 3)
        (sotrudnik PushkinAS 3)
)

(retract 1)

(retract 3)
(assert (sotrudnik VasilevKD 3))

// Products
(assert (IceCream Russia 10 1)
		(ApelsineJuce Russia 20 2)
		(WaterMelone Russia 30 3)
		(Liberty USA 1000 99)
)

(facts)

(retract 2)
(ApelsineJuce Russia 19 2)

(retract 4)
(Liberty USA 0 99)


Removed the is-macro slot from the Pass class.

This keeps the logic of the pipeline really simple while forcing the programmer
to pick up the slack.

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (> (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

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

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  ; this slot will allow us to expand passes that consist of multiple modules
  ; before changing focus to that module. This can be set to false even if
  ; there are submodules so that the programmer can control the process
  ; themselves. This is a convience feature more than anything else.
  (slot is-macro (type SYMBOL) (allowed-symbols FALSE TRUE))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (> (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

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