fixed a bug in WavefrontOperandRename when calling get-Pointer

;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.
;------------------------------------------------------------------------------
; Now we need to rename operands as need be within the blocks that these
; instructions have been scheduled into
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::AssertReplacementActions
         "Iterates through the replacement actions multifield and asserts facts
         related to the replacement of given values with another value"
         (declare (salience 100))
         (object (is-a PathAggregate)
                 (parent ?e)
                 (ReplacementActions $? ?orig ?new ! $?))
         =>
         ; I have turned you into a cheese sandwich, what do you say to that?
         (assert (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUses
         (declare (salience 20))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))
         (object (is-a Instruction)
                 (id ?orig)
                 (pointer ?oPtr))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         (object (is-a BasicBlock)
                 (id ?e)
                 (contents $? ?new $?rest))
         =>
         (bind ?ptrList (create$))
         (bind ?symList (create$))
         (bind ?i0 1)
         (progn$ (?var $?rest)
                 (bind ?obj (instance-address * (symbol-to-instance-name ?var)))
                 (bind ?oOps (send ?obj get-Operands))
                 (if (member$ ?orig ?oOps) then
                   (bind ?ptrTmp (send ?obj get-pointer))
                   (bind ?ptrList (insert$ ?ptrList ?i0 ?ptrTmp))
                   (bind ?symList (insert$ ?symList ?i0 ?var))
                   (bind ?i0 (+ ?i0 1))))
         ;reuse ?fct's memory
         (modify ?fct (action replace-uses-clips)
                 (arguments ?orig => ?new for ?symList))
         (assert (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?oPtr => ?nPtr for ?ptrList))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInLLVM
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?from => ?to for $?p2))
         =>
         (if (llvm-replace-uses ?from ?to ?p2) then
           (retract ?fct)
           else
           (printout t
                     "Some kind of error occured when trying to replace uses. "
                     crlf "Make sure that you've done arguments correctly. "
                     crlf "The failing rule is ReplaceUsesInLLVM." crlf
                     "?from = " ?from crlf
                     "?to = " ?to crlf
                     "?p2 = " ?p2 crlf
                     "Now I'm halting execution" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ?from => ?to for ?symbol $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (Operands $?operands)
                          (LocalDependencies $?locDep)
                          (NonLocalDependencies $?nLocDep))
         =>
         (modify-instance ?inst (Operands)
                          (LocalDependencies)
                          (NonLocalDependencies))
         (modify ?fct (arguments ?from => ?to for $?rest))
         (assert (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?from => ?to
                                     replacement ?symbol
                                     operands $?operands))
                 (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?locDep))
                 (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?nLocDep))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS-End
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ? => ? for))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (modify-instance ?inst (LocalDependencies $?locDep ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (object-pattern-match-delay
           (modify-instance ?inst (LocalDependencies $?locDep ?to))
           (modify ?fct (arguments ?from => ?to
                                   in ?symbol
                                   contents $?rest))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?to))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?op&~?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?op))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?t))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Empty
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ? => ?
                                     replacement ?
                                     operands))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------

;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.
;------------------------------------------------------------------------------
; Now we need to rename operands as need be within the blocks that these
; instructions have been scheduled into
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::AssertReplacementActions
         "Iterates through the replacement actions multifield and asserts facts
         related to the replacement of given values with another value"
         (declare (salience 100))
         (object (is-a PathAggregate)
                 (parent ?e)
                 (ReplacementActions $? ?orig ?new ! $?))
         =>
         ; I have turned you into a cheese sandwich, what do you say to that?
         (assert (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUses
         (declare (salience 20))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))
         (object (is-a Instruction)
                 (id ?orig)
                 (pointer ?oPtr))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         (object (is-a BasicBlock)
                 (id ?e)
                 (contents $? ?new $?rest))
         =>
         (bind ?ptrList (create$))
         (bind ?symList (create$))
         (bind ?i0 1)
         (progn$ (?var $?rest)
                 (bind ?obj (instance-address * (symbol-to-instance-name ?var)))
                 (bind ?oOps (send ?obj get-Operands))
                 (if (member$ ?orig ?oOps) then
                   (bind ?ptrTmp (send ?obj get-Pointer))
                   (bind ?ptrList (insert$ ?ptrList ?i0 ?ptrTmp))
                   (bind ?symList (insert$ ?symList ?i0 ?var))
                   (bind ?i0 (+ ?i0 1))))
         ;reuse ?fct's memory
         (modify ?fct (action replace-uses-clips)
                 (arguments ?orig => ?new for ?symList))
         (assert (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?oPtr => ?nPtr for ?ptrList))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInLLVM
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?from => ?to for $?p2))
         =>
         (if (llvm-replace-uses ?from ?to ?p2) then
           (retract ?fct)
           else
           (printout t
                     "Some kind of error occured when trying to replace uses. "
                     crlf "Make sure that you've done arguments correctly. "
                     crlf "The failing rule is ReplaceUsesInLLVM." crlf
                     "?from = " ?from crlf
                     "?to = " ?to crlf
                     "?p2 = " ?p2 crlf
                     "Now I'm halting execution" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ?from => ?to for ?symbol $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (Operands $?operands)
                          (LocalDependencies $?locDep)
                          (NonLocalDependencies $?nLocDep))
         =>
         (modify-instance ?inst (Operands)
                          (LocalDependencies)
                          (NonLocalDependencies))
         (modify ?fct (arguments ?from => ?to for $?rest))
         (assert (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?from => ?to
                                     replacement ?symbol
                                     operands $?operands))
                 (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?locDep))
                 (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?nLocDep))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS-End
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ? => ? for))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (modify-instance ?inst (LocalDependencies $?locDep ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (object-pattern-match-delay
           (modify-instance ?inst (LocalDependencies $?locDep ?to))
           (modify ?fct (arguments ?from => ?to
                                   in ?symbol
                                   contents $?rest))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?to))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?op&~?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?op))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?t))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Empty
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ? => ?
                                     replacement ?
                                     operands))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------


rendomly changed

rendomly changed

; -*- clips -*-

;; **********************************************************************
;;                           Frame.clp
;;
;; A nifty example of building a a Swing GUI using jess reflection.
;; Using this package, we can create java objects, call their methods,
;; access their fields, and respond to GUI events.
;; You can therefore build an entire GUI application without actually
;; writing any Java code!
;;
;; **********************************************************************

;; ******************************
;; Declarations

(import javax.swing.*)
;; Explicit import so we get JFrame.EXIT_ON_CLOSE
(import javax.swing.JFrame)
(import java.awt.event.ActionListener)
(import java.awt.BorderLayout)
(import java.awt.Color)

;; ******************************
;; DEFGLOBALS

(defglobal ?*f* = 0)
(defglobal ?*c* = 0)
(defglobal ?*d* = 0)
(defglobal ?*e* = 0)

(defglobal ?*m* = 0)
(defglobal ?*envi* = 0)

;; ******************************
;; DEFFUNCTIONS

(deffunction create-frame ()
  (bind ?*f* (new JFrame "Jess Reflection Demo"))
  (bind ?*c* (?*f* getContentPane))
  (set ?*c* background (Color.magenta)))

(deffunction add-widgets ()
  (?*c* add (new JLabel "This is: ") (BorderLayout.CENTER))
  (bind ?*m* (new JComboBox))
  (bind ?*d* (new JComboBox))
  (bind ?*e* (new JComboBox))
  (?*m* addItem "paper")
  (?*m* addItem "tools")
  (?*m* addItem "buildings")
  (?*m* addItem "numbers")
  (?*c* add ?*m* (BorderLayout.SOUTH))
  (bind ?*envi* ?*m* selectedItem)
  (assert (environment ?*envi*))
  (?*e* addItem "paper")
  (?*e* addItem "tools")
  (?*e* addItem "buildings")
  (?*e* addItem "numbers")
  (?*c* add ?*e* (BorderLayout.NORTH))
  (bind ?*envi* ?*m* selectedItem)
  (assert (environment ?*envi*))
  (?*d* addItem "paper")
  (?*d* addItem "tools")
  (?*d* addItem "buildings")
  (?*d* addItem "numbers")
  (?*c* add ?*d* )
  (bind ?*envi* ?*d* selectedItem )
  (assert (environment ?*envi*)))

(deffunction add-behaviours ()
  (?*f* setDefaultCloseOperation (JFrame.EXIT_ON_CLOSE))

  (?*m* addActionListener (implement ActionListener using
    (lambda (?name ?event)
      (printout t "You chose: " (get ?*m* selectedItem) crlf)))))

(deffunction show-frame ()
  ;(?*f* pack)
    (?*f* setSize 200 300)
  (?*f* setVisible TRUE))

;; ******************************
;; Run the program

(defrule init-rule
    (initial-fact)
    =>
    (create-frame)
    (add-widgets)
    (add-behaviours)
    (show-frame))

(reset)
(run)

;;test now 2
;;howareyougit
;;sadasdh
;asdhasdhoas;shdklfjhsdjk


added functions to help compute unix permissions

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

;------------------------------------------------------------------------------
; Make umask, mkdir, and mkfifo a little less raw to work with
;------------------------------------------------------------------------------
(defgeneric compute-perms)
;------------------------------------------------------------------------------
(defmethod compute-perms
  ((?self INTEGER (and (>= ?self 0)
                       (< ?self 8)))
   (?group INTEGER (and (>= ?group 0)
                        (< ?group 8)))
   (?all INTEGER (and (>= ?all 0)
                      (< ?all 8))))
  (binary-or (left-shift ?self 6)
             (binary-or (left-shift ?group 3)
                        ?all)))
(defmethod compute-perms
  ((?self SYMBOL)
   (?group SYMBOL)
   (?all SYMBOL))
  (compute-perms (compute-perms ?self)
                 (compute-perms ?group)
                 (compute-perms ?all)))

(defmethod compute-perms
  ((?set SYMBOL (eq ?set r))) 4)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set w))) 2)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set x))) 1)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set rwx))) 7)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set rw))) 6)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set rx))) 5)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set wx))) 3)

error: pathspec 'sys/os/unix/permissions.clp' did not match any file(s) known to git


Deleted /sys/os/unix/permissions.clp

Deleted /sys/os/unix/permissions.clp

This is a little too much os specific functionality for my tastes

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

;------------------------------------------------------------------------------
; Make umask, mkdir, and mkfifo a little less raw to work with
;------------------------------------------------------------------------------
(defgeneric compute-perms)
;------------------------------------------------------------------------------
(defmethod compute-perms
  ((?self INTEGER (and (>= ?self 0)
                       (< ?self 8)))
   (?group INTEGER (and (>= ?group 0)
                        (< ?group 8)))
   (?all INTEGER (and (>= ?all 0)
                      (< ?all 8))))
  (binary-or (left-shift ?self 6)
             (binary-or (left-shift ?group 3)
                        ?all)))
(defmethod compute-perms
  ((?self SYMBOL)
   (?group SYMBOL)
   (?all SYMBOL))
  (compute-perms (compute-perms ?self)
                 (compute-perms ?group)
                 (compute-perms ?all)))

(defmethod compute-perms
  ((?set SYMBOL (eq ?set r))) 4)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set w))) 2)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set x))) 1)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set rwx))) 7)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set rw))) 6)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set rx))) 5)
(defmethod compute-perms
  ((?set SYMBOL (eq ?set wx))) 3)


Fixed a bug with incorrect parents for paths starting with regions

I used the parent of the basic block that was not directly owned by the region
being pathed. This has been changed to the name of the region itself (?id)

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PathConstruction.clp - Contains rules devoted to starting the construction of
; a given path through a given region. Rewritten to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-region
         (declare (salience 3))
         (message (to paths-conditional)
                  (action build-path))
         ?fct <- (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?id))
         ?r0 <- (object (is-a Region)
                        (id ?id)
                        (Entrances $? ?a $?)
                        (contents $? ?z $?))
         (object (is-a Region&~Loop)
                 (id ?z)
                 (parent ?id)
                 (Entrances $? ?a $?))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?n&~?id))
         =>
         (retract ?fct)
         (make-instance of Path
                        (parent ?id)
                        (values ?z)))
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-basicblock
         (declare (salience 3))
         (message (to paths-conditional)
                  (action build-path))
         ?fct <- (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?id))
         ?r0 <- (object (is-a Region)
                        (id ?id)
                        (Entrances $? ?a $?))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?n))
         =>
         (retract ?fct)
         (make-instance of Path
                        (parent ?n)
                        (values ?a)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; PathConstruction.clp - Contains rules devoted to starting the construction of
; a given path through a given region. Rewritten to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-region
         (declare (salience 3))
         (message (to paths-conditional)
                  (action build-path))
         ?fct <- (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?id))
         ?r0 <- (object (is-a Region)
                        (id ?id)
                        (Entrances $? ?a $?)
                        (contents $? ?z $?))
         (object (is-a Region)
                 (id ?z)
                 (parent ?id)
                 (Entrances $? ?a $?))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?n&~?id))
         =>
         (retract ?fct)
         (make-instance of Path
                        (parent ?n)
                        (values ?z)))
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-basicblock
         (declare (salience 3))
         (message (to paths-conditional)
                  (action build-path))
         ?fct <- (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?id))
         ?r0 <- (object (is-a Region)
                        (id ?id)
                        (Entrances $? ?a $?))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?n))
         =>
         (retract ?fct)
         (make-instance of Path
                        (parent ?n)
                        (values ?a)))
;------------------------------------------------------------------------------


Create task4.clp

Create task4.clp

(defrule easy_summ
  =>
  (printout t "n=")
  (bind ?n (read))
  (bind ?s 0)
  (bind ?i 2)
  (while (<= ?i (* 2 ?n)) do
   (bind ?s (+ ?s (/ 1 (* ?i ?i))))
   (bind ?i (+ ?i 2))
  )
  (printout t "summ is:")
  (printout t ?s)
  (printout t "")
)

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


WidgetElement.clp: Added slots for children, width, and height

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

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


Changed the module for the Path type to be types::Path

The use of the generic types module allows one to define types that are meant
to be exposed globally.

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Path.clp - Contains the definition of the pass class
;------------------------------------------------------------------------------
(defclass types::Path
  (is-a ParentedHint)
  (slot Exit (type SYMBOL))
  (slot Closed (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(defmessage-handler types::Path init after
 ()
 (bind ?self:Type Path))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Path.clp - Contains the definition of the pass class
;------------------------------------------------------------------------------
(defclass path::Path
  (is-a ParentedHint)
  (slot Exit (type SYMBOL))
  (slot Closed (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(defmessage-handler path::Path init after
 ()
 (bind ?self:Type Path))
;------------------------------------------------------------------------------


reset-run-exit now uses the 2 clause BSD license

;------------------------------------------------------------------------------
;electron-filesystem
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;
;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 THE COPYRIGHT HOLDER OR CONTRIBUTORS 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.
;------------------------------------------------------------------------------
; reset-run-exit.clp - Calls reset, run, and then exits. This is useful for
;                      expert systems that are meant to run and then exit
;
; Obviously, this prevent shell access.
;------------------------------------------------------------------------------
(reset)
(run)
(exit)

;------------------------------------------------------------------------------
;electron-filesystem
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of electron-filesystem nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; reset-run-exit.clp - Calls reset, run, and then exits. This is useful for
;                      expert systems that are meant to run and then exit
;
; Obviously, this prevent shell access.
;------------------------------------------------------------------------------
(reset)
(run)
(exit)


Added a type field to file-line

Added a type field to file-line

I added a rule as well to mark lines that are group headings

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
(defclass 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 opened-file next-index ()
 (bind ?old ?self:index)
 (bind ?self:index (+ ?old 1))
 (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler opened-file read-line ()
 (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler opened-file close-file ()
 (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate file-line
 (slot index)
 (slot parent)
 (slot type)
 (multifield contents))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction get-input-form-factor ()
 (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule 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 (read file ?name))
 else
 (printout t "ERROR: target file at " ?path " does not exist!" crlf
  "Halting!" crlf)
 (halt)))
;------------------------------------------------------------------------------
(defrule build-file-line
 ?fct <- (read file ?fid)
 ?obj <- (object (is-a opened-file)
                 (id ?fid))
 =>
 (retract ?fct)
 (bind ?result (send ?obj read-line))
 (if (neq ?result EOF) then
  (assert (read file ?fid)
          (file-line (index (send ?obj next-index))
           (type UNKNOWN)
           (parent ?fid)
           (contents (explode$ ?result))))
  else
  (send ?obj close-file)
  (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule retract-blank-lines
 ?f <- (file-line (contents))
 =>
 (retract ?f))
;------------------------------------------------------------------------------
(defrule mark-heading-groups
 "Tags lines that consist of /* $? */ as group headings"
 ?f <- (file-line (contents /* $? */) (type UNKNOWN))
 =>
 (modify ?f (type heading)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
(defclass 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 opened-file next-index ()
 (bind ?old ?self:index)
 (bind ?self:index (+ ?old 1))
 (return ?old))
;------------------------------------------------------------------------------
(defmessage-handler opened-file read-line ()
 (readline ?self:id))
;------------------------------------------------------------------------------
(defmessage-handler opened-file close-file ()
 (close ?self:id))
;------------------------------------------------------------------------------
(deftemplate file-line
 (slot index)
 (slot parent)
 (multifield contents))
;------------------------------------------------------------------------------
; INPUT FACT FORM: (parse constant file ?path)
;------------------------------------------------------------------------------
(deffunction get-input-form-factor ()
 (printout t "(parse constant file ?path)" crlf))
;------------------------------------------------------------------------------
(defrule 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 (read file ?name))
 else
 (printout t "ERROR: target file at " ?path " does not exist!" crlf
  "Halting!" crlf)
 (halt)))
;------------------------------------------------------------------------------
(defrule build-file-line
 ?fct <- (read file ?fid)
 ?obj <- (object (is-a opened-file)
                 (id ?fid))
 =>
 (retract ?fct)
 (bind ?result (send ?obj read-line))
 (if (neq ?result EOF) then
  (assert (read file ?fid)
          (file-line (index (send ?obj next-index))
           (parent ?fid)
           (contents (explode$ ?result))))
  else
  (send ?obj close-file)
  (unmake-instance ?obj)))
;------------------------------------------------------------------------------
(defrule retract-blank-lines
 ?f <- (file-line (contents))
 =>
 (retract ?f))
;------------------------------------------------------------------------------


WidgetElement.clp: Added x and y slot positions to describe location

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

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


Deleted references to lobe and dendrite from LoadEngine.clp

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


Modified GLAPIConversion.clp to maintain an arg index in an unordered fashion

By using the number of preceeding commas + 1 it is possible to figure out the
position of a given argument without having to maintain state that would be
difficult to keep correct. The tradeoff is a linear count of the number of
commas for each argument on each call. This tradeoff only makes the code a
little less efficient while making it far easier to maintain.

;------------------------------------------------------------------------------
;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))))
;------------------------------------------------------------------------------
(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::parse-arguments
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  ; this is going backwards, we defer the index field
								  ; by setting it as an offset of the length, which we
								  ; don't know until we actually generate these
								  ; arguments.
								  (arguments ?o => $?sentry "," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?sentry))
			;we use the number of commas before plus 1 to determine index
			(bind ?index (+ (count-commas ?sentry) 1))
			;the problem is determining the direction to spit out an argument in
			;I don't want to assume backwards or forwards to tell the truth. So
			;that means that we just mark $?rest with the target index and move on
			;
			;This method is technically out of order due to the use of the , as a
			;fix point
			(duplicate ?fct (action build-argument)
			                (arguments ?o ?index => $?rest)))
;------------------------------------------------------------------------------
(defrule build-groups::create-last-argument
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			=>
			;The last element doesn't contain any commas and thus must be zero
			(modify ?fct (action build-argument)
			             (arguments ?o 0 => $?all)))
;------------------------------------------------------------------------------
(defrule build-groups::retract-empty-parse-message
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
;(defrule build-groups::argument-is-fixed-array
;			(declare (salience 1))
;			?fct <- (message (to build-groups)
;								  (action build-argument)
;								  (arguments ?o ?name ?ind => $?field "[" ?size "]"))
;			=>
;			(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 ?name ?ind => $?input))
;			=>
;			(modify ?fct (to grouping-update)
;					  (action populate-argument)
;					  (arguments ?name => $?input))
;			(make-instance ?name of GLAPIArgument
;								(parent ?o)
;								(index ?ind)))
;------------------------------------------------------------------------------
(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))
			=>
			(retract ?fct)
			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::printout-arguments
			(declare (salience -10))
			?obj <- (object (is-a GLAPIArgument))
			=>
			(printout t (send ?obj reconstitute) 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.
;------------------------------------------------------------------------------
; 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)
  (multislot arguments)
  (message-handler add-argument))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFunction add-argument
						  "Adds the arg name and returns the index"
						  (?name)
						  (bind ?index (length$ ?self:arguments))
						  (if (= 0 ?index) then
							 (slot-direct-insert$ arguments 1 ?name)
							 (return 1)
							 else
							 (slot-direct-insert$ arguments ?index ?name)
							 (return ?index)))
;------------------------------------------------------------------------------
(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))))
;------------------------------------------------------------------------------
(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))))
;------------------------------------------------------------------------------
(defrule build-groups::parse-arguments
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  ; this is going backwards
								  (arguments ?o => $?sentry "," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(bind ?ind (send ?obj add-argument ?name))
			(modify ?fct (arguments ?o => $?rest))
			(duplicate ?fct (action build-argument)
						  (arguments ?o ?name ?ind => $?sentry)))
;------------------------------------------------------------------------------
(defrule build-groups::create-last-argument
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			=>
			(bind ?name (gensym*))
			(bind ?ind (send ?obj add-argument ?name))
			(modify ?fct (action build-argument)
					  (arguments ?o ?name ?ind => $?all)))
;------------------------------------------------------------------------------
(defrule build-groups::retract-empty-parse-message
			?fct <- (message (to build-groups)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule build-groups::argument-is-fixed-array
			(declare (salience 1))
			?fct <- (message (to build-groups)
								  (action build-argument)
								  (arguments ?o ?name ?ind => $?field "[" ?size "]"))
			=>
			(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 ?name ?ind => $?input))
			=>
			(modify ?fct (to grouping-update)
					  (action populate-argument)
					  (arguments ?name => $?input))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index ?ind)))
;------------------------------------------------------------------------------
(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))
			=>
			(retract ?fct)
			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::printout-arguments
			(declare (salience -10))
			?obj <- (object (is-a GLAPIArgument))
			=>
			(printout t (send ?obj reconstitute) crlf))
;------------------------------------------------------------------------------