Create task5.clp

Create task5.clp

(defrule bank
  =>
  (printout t "p=")
  (bind ?p (read))
  (printout t "You need wait: " (max (round (/ (log 2) (log (+ 1 ?p)))) (round (+ 0.5 (/ (log 2) (log (+ 1 ?p)))))))
)

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


Create task5.clp

Create task5.clp

(deffunction trim (?str)
    (bind ?str2 "")
    (bind ?space True)
    (bind ?n (str-length ?str))
    (bind ?i 0)
    (while (< ?i ?n) do
        (bind ?c1 (sub-string ?i ?i ?str))

        (if (= 0 (str-compare ?c1 " ")) then
            (if (and (?space True)) then
                (printout t "kefal")
                (bind ?space False)
                (bind ?str2 (str-cat ?str2 ?c1))
            )

        else

            (bind ?space True)
            (bind ?str2 (str-cat ?str2 ?c1))
        )
        (bind ?i (+ ?i 1))
    )
    ?str2
)

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


Added debug INFO when SV is updated.

Added debug INFO when SV is updated.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		DEFTEMPLATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftemplate waiting
	(slot cmd (type STRING))
	(slot id (type INTEGER))
	(slot args (type STRING))
	(slot timeout
		(type INTEGER)
		(range 0 ?VARIABLE)
	)
	(slot attempts
		(type INTEGER)
		(range 1 ?VARIABLE)
	)
	(slot symbol
		(type SYMBOL)
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		BB FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deffunction send-command
	; Receives: command, symbol identifier, cmd_params and optionally
	;timeout and number of attempts in case it times out or fails.
	; Symbol identifier is useful for tracking responses through rules.
	(?cmd ?sym ?args $?settings)
	(bind ?timeout ?*defaultTimeout*)
	(bind ?attempts ?*defaultAttempts*)
	(switch (length$ $?settings)
		(case 1 then
			(bind ?timeout (nth$ 1 $?settings))
		)
		(case 2 then
			(bind ?timeout (nth$ 1 $?settings))
			(bind ?attempts (nth$ 2 $?settings))
		)
	)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(if (> ?timeout 0) then
		(setCmdTimer ?timeout ?cmd ?id)
	)
	(assert
		(waiting (cmd ?cmd) (id ?id) (args ?args) (timeout ?timeout) (attempts ?attempts) (symbol ?sym) )
	)
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts " - time: " (time) " - params: " ?args)
	(return ?id)
)

(deffunction send-response
	; Receives: command, id, result and params
	(?cmd ?id ?result ?params)
	(python-call SendResponse ?cmd ?id ?result ?params)
	(log-message INFO "Sent response: '" ?cmd "' - id: " ?id " - result: " ?result "params: " ?params)
;	(halt)
)

(deffunction create-shared_var
	; Receives: type and name
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name)
	(bind ?resp (python-call CreateSharedVar ?type ?name))
	(if (eq ?resp 1) then
		(log-message INFO "Created SharedVar: " ?name)
	else
		(log-message WARNING "SharedVar: '" ?name "' could NOT be created!")
	)
	(return ?resp)
)

(deffunction write-shared_var
	; Receives: type, name and data
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name $?data)
	(bind ?resp (python-call WriteSharedVar ?type ?name $?data))
	(if (eq ?resp 1) then
		(log-message INFO "Written to SharedVar: '" ?name "' - " $?data)
	else
		(log-message WARNING "Could NOT write to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

(deffunction subscribe_to-shared_var
	; Receives: name and optionally subscription type and report type
	; Subscription type is one of: creation | writemodule | writeothers | writeany
	; report type is one of: content | notify
	(?name $?options)
	(bind ?resp (python-call SubscribeToSharedVar ?name $?options) )
	(if (eq ?resp 1) then
		(log-message INFO "Subscribed to SharedVar: '" ?name "'")
		(assert
			(BB_subscribed_to_var ?name)
		)
	else
		(log-message WARNING "Could NOT subscribe to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		RULES TO HANDLE BB (PYTHON) ASSERTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-waiting-timedout-without_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts 1) (args ?args) (timeout ?timeout&~0) (symbol ?sym) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(assert
		(BB_answer ?cmd ?sym 0 ?args)
	)
	(retract ?w ?BB)
	(log-message WARNING "Command timedout w/o attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - time: " (time))
)

(defrule BB-waiting-timedout-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(retract ?BB)
	(log-message WARNING "Command timedout w/ attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts " - time: " (time))
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(bind ?attempts (- ?attempts 1))
	(modify ?w (id ?id) (attempts ?attempts))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-failed-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_received ?cmd ?id 0 ?)
	=>
	(retract ?BB)
	(log-message WARNING "Command failed w/ attempts: '" ?cmd "' - id: " ?id " - attempts: " ?attempts " - time: " (time))
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(modify ?w (id ?id) (attempts (- ?attempts 1)))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-set_answer
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts ?attempts) (symbol ?sym))
	?BB <-(BB_received ?cmd ?id ?result ?params)
	(test (or (eq ?result 1) (eq ?attempts 1)))
	=>
	(retract ?w ?BB)
	(assert
		(BB_answer ?cmd ?sym ?result ?params)
	)
	(log-message INFO "Answer received: '" ?cmd "' - id: " ?id " - successful: " ?result " - response: " ?params)
)

(defrule BB-clear-timers
	(declare (salience -9501))
	?t <-(BB_timer ?cmd ?id)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?t)
	(log-message INFO "Clearing timer for command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_response
	(declare (salience -9501))
	?BB <-(BB_received ?cmd ?id $?)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?BB)
	(log-message WARNING "Clearing unhandled response from command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_answer
	(declare (salience -9501))
	?BB <-(BB_answer ?cmd ?sym ?result ?params)
	=>
	(retract ?BB)
	(log-message INFO "Clearing answer from command: '" ?cmd "' - sym: " ?sym "' - result: " ?result "' - params: " ?params)
)

;	HANDLE SHARED VAR UPDATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-clear_sv_update
	(declare (salience -9501))
	?BB <-(BB_sv_updated $?)
	=>
	(retract ?BB)
)

(defrule BB-set_sv
	(declare (salience 9501))
	(not (BB_sv_updated ?name $?))
	?f <-(BB_set_sv_updated ?name $?data)
	=>
	(retract ?f)
	(assert
		(BB_sv_updated ?name $?data)
	)
  (log-message INFO "SV_UPDATED: " ?name $?data crlf)
;	(printout t "SV_UPDATED: " ?name " " $?data crlf)
)

(defrule BB-update_sv
	(declare (salience 9501))
	?BB <-(BB_sv_updated ?name $?)
	?f <-(BB_set_sv_updated ?name $?data)
	=>
	(retract ?BB ?f)
	(assert
		(BB_sv_updated ?name $?data)
	)
  (log-message INFO "SV_UPDATED: " ?name $?data crlf)
;	(printout t "SV_UPDATED: " ?name " " $?data crlf)
)

(defrule BB-unknown-command
	(declare (salience -9501))
	?BB <-(BB_cmd ?cmd ?id ?params)
	=>
	(retract ?BB)
	(send-response ?cmd ?id FALSE "unknown command")
	(log-message WARNING "Unhandled command received: " ?cmd)
;	(halt)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		DEFTEMPLATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftemplate waiting
	(slot cmd (type STRING))
	(slot id (type INTEGER))
	(slot args (type STRING))
	(slot timeout
		(type INTEGER)
		(range 0 ?VARIABLE)
	)
	(slot attempts
		(type INTEGER)
		(range 1 ?VARIABLE)
	)
	(slot symbol
		(type SYMBOL)
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		BB FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deffunction send-command
	; Receives: command, symbol identifier, cmd_params and optionally
	;timeout and number of attempts in case it times out or fails.
	; Symbol identifier is useful for tracking responses through rules.
	(?cmd ?sym ?args $?settings)
	(bind ?timeout ?*defaultTimeout*)
	(bind ?attempts ?*defaultAttempts*)
	(switch (length$ $?settings)
		(case 1 then
			(bind ?timeout (nth$ 1 $?settings))
		)
		(case 2 then
			(bind ?timeout (nth$ 1 $?settings))
			(bind ?attempts (nth$ 2 $?settings))
		)
	)
	(bind ?id (python-call SendCommand ?cmd ?args))
	(if (> ?timeout 0) then
		(setCmdTimer ?timeout ?cmd ?id)
	)
	(assert
		(waiting (cmd ?cmd) (id ?id) (args ?args) (timeout ?timeout) (attempts ?attempts) (symbol ?sym) )
	)
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts " - time: " (time) " - params: " ?args)
	(return ?id)
)

(deffunction send-response
	; Receives: command, id, result and params
	(?cmd ?id ?result ?params)
	(python-call SendResponse ?cmd ?id ?result ?params)
	(log-message INFO "Sent response: '" ?cmd "' - id: " ?id " - result: " ?result "params: " ?params)
;	(halt)
)

(deffunction create-shared_var
	; Receives: type and name
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name)
	(bind ?resp (python-call CreateSharedVar ?type ?name))
	(if (eq ?resp 1) then
		(log-message INFO "Created SharedVar: " ?name)
	else
		(log-message WARNING "SharedVar: '" ?name "' could NOT be created!")
	)
	(return ?resp)
)

(deffunction write-shared_var
	; Receives: type, name and data
	;type is one of: byte[] | int | int[] | long | long[] |
	; double | double[] | string | matrix | RecognizedSpeech | var
	(?type ?name $?data)
	(bind ?resp (python-call WriteSharedVar ?type ?name $?data))
	(if (eq ?resp 1) then
		(log-message INFO "Written to SharedVar: '" ?name "' - " $?data)
	else
		(log-message WARNING "Could NOT write to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

(deffunction subscribe_to-shared_var
	; Receives: name and optionally subscription type and report type
	; Subscription type is one of: creation | writemodule | writeothers | writeany
	; report type is one of: content | notify
	(?name $?options)
	(bind ?resp (python-call SubscribeToSharedVar ?name $?options) )
	(if (eq ?resp 1) then
		(log-message INFO "Subscribed to SharedVar: '" ?name "'")
		(assert
			(BB_subscribed_to_var ?name)
		)
	else
		(log-message WARNING "Could NOT subscribe to SharedVar: '" ?name "'")
	)
	(return ?resp)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		RULES TO HANDLE BB (PYTHON) ASSERTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-waiting-timedout-without_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts 1) (args ?args) (timeout ?timeout&~0) (symbol ?sym) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(assert
		(BB_answer ?cmd ?sym 0 ?args)
	)
	(retract ?w ?BB)
	(log-message WARNING "Command timedout w/o attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - time: " (time))
)

(defrule BB-waiting-timedout-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_timer ?cmd ?id)
	(not
		(BB_received ?cmd ?id $?)
	)
	=>
	(retract ?BB)
	(log-message WARNING "Command timedout w/ attempts: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts " - time: " (time))
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(bind ?attempts (- ?attempts 1))
	(modify ?w (id ?id) (attempts ?attempts))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-failed-with_attempts
	?w <-(waiting (cmd ?cmd) (id ?id) (args ?args) (attempts ?attempts&~1) (timeout ?timeout&~0) )
	?BB <-(BB_received ?cmd ?id 0 ?)
	=>
	(retract ?BB)
	(log-message WARNING "Command failed w/ attempts: '" ?cmd "' - id: " ?id " - attempts: " ?attempts " - time: " (time))
	(bind ?id (python-call SendCommand ?cmd ?args))
	(setCmdTimer ?timeout ?cmd ?id)
	(modify ?w (id ?id) (attempts (- ?attempts 1)))
	(log-message INFO "Sent command: '" ?cmd "' - id: " ?id " - timeout: " ?timeout "ms - attempts: " ?attempts)
)

(defrule BB-set_answer
	?w <-(waiting (cmd ?cmd) (id ?id) (attempts ?attempts) (symbol ?sym))
	?BB <-(BB_received ?cmd ?id ?result ?params)
	(test (or (eq ?result 1) (eq ?attempts 1)))
	=>
	(retract ?w ?BB)
	(assert
		(BB_answer ?cmd ?sym ?result ?params)
	)
	(log-message INFO "Answer received: '" ?cmd "' - id: " ?id " - successful: " ?result " - response: " ?params)
)

(defrule BB-clear-timers
	(declare (salience -9501))
	?t <-(BB_timer ?cmd ?id)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?t)
	(log-message INFO "Clearing timer for command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_response
	(declare (salience -9501))
	?BB <-(BB_received ?cmd ?id $?)
	(not
		(waiting (cmd ?cmd) (id ?id))
	)
	=>
	(retract ?BB)
	(log-message WARNING "Clearing unhandled response from command: '" ?cmd "' - id: " ?id)
)

(defrule BB-clear_answer
	(declare (salience -9501))
	?BB <-(BB_answer ?cmd ?sym ?result ?params)
	=>
	(retract ?BB)
	(log-message INFO "Clearing answer from command: '" ?cmd "' - sym: " ?sym "' - result: " ?result "' - params: " ?params)
)

;	HANDLE SHARED VAR UPDATES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrule BB-clear_sv_update
	(declare (salience -9501))
	?BB <-(BB_sv_updated $?)
	=>
	(retract ?BB)
)

(defrule BB-set_sv
	(declare (salience 9501))
	(not (BB_sv_updated ?name $?))
	?f <-(BB_set_sv_updated ?name $?data)
	=>
	(retract ?f)
	(assert
		(BB_sv_updated ?name $?data)
	)
)

(defrule BB-update_sv
	(declare (salience 9501))
	?BB <-(BB_sv_updated ?name $?)
	?f <-(BB_set_sv_updated ?name $?data)
	=>
	(retract ?BB ?f)
	(assert
		(BB_sv_updated ?name $?data)
	)
)

(defrule BB-unknown-command
	(declare (salience -9501))
	?BB <-(BB_cmd ?cmd ?id ?params)
	=>
	(retract ?BB)
	(send-response ?cmd ?id FALSE "unknown command")
	(log-message WARNING "Unhandled command received: " ?cmd)
;	(halt)
)


Deleted fs.clp because it is no longer necessary

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; fs.clp - Initializes the file system and handlers. This is the entry point
;          into the filesystem
;------------------------------------------------------------------------------
(defglobal MAIN
           ; Change the value of this global to change the name of the
           ; corresponding shell variable.
           ?*electron-fs-root* = ElectronFSRoot
           ; Use this to make sure that we fail out if we can't bootstrap
           ?*fs* = (progn (bind ?result (get-shell-variable ?*electron-fs-root*))
                          (if (not ?result) then
                            (printout t "ERROR: " ?*electron-fs-root* " not defined - Exiting" crlf)
                            (exit)
                            else
                            ?result)))
;------------------------------------------------------------------------------
; Now that we have a base point we can really define some elegant fs points
; Use fs as a builder of paths. I believe it's quite elegant :D
;------------------------------------------------------------------------------
(defgeneric fs)
;------------------------------------------------------------------------------
(defmethod fs () ?*fs*)
(defmethod fs
  "Builds a path around the electron file system from the root"
  ((?atoms MULTIFIELD))
  (str-cat ?*fs* (expand$ ?atoms)))
(defmethod fs
  ($?atoms)
  (fs ?atoms))

;------------------------------------------------------------------------------
; Define the filesystem now
;------------------------------------------------------------------------------
(defglobal MAIN
           ; dev directory - put fifos here to read and write from
           ?*/dev* = (fs /dev)
           ; lib directory
           ?*/lib* = (fs /lib)
           ; data directory
           ?*/data* = (fs /data)
           ; bin directory
           ?*/bin* = (fs /bin)
           ; etc directory
           ?*/etc* = (fs /etc)
           ; logic directory
           ?*/logic* = (fs /logic))


Added paths-conditional to the PassRegistry

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

(definstances PersistentPassRegistry
 ([test] of Pass
  (entry-point "passes/test/PassHeader.clp")
  (pass-name test)
  (pass-description "A test of the indirect pass system")
  (pass-type Module)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes test)
  (required loops regions)
  (preserves-cfg TRUE)
  (preserves-all TRUE))
 ([paths] of Pass
  (entry-point "passes/path/all/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))
 ([paths-conditional] of Pass
  (entry-point "passes/path/conditional/PassHeader.clp")
  (pass-name paths-conditional)
  (pass-description "Generate the set of paths through a set of target regions")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths-conditional)
  (required loops regions))
 ;Add more passes here
)
;------------------------------------------------------------------------------

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

;This is part of the MAIN module
(definstances PersistentPassRegistry
 ([test] of Pass
  (entry-point "passes/test/PassHeader.clp")
  (pass-name test)
  (pass-description "A test of the indirect pass system")
  (pass-type Module)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes test)
  (required loops regions)
  (preserves-cfg TRUE)
  (preserves-all TRUE))
 ([paths] of Pass
  (entry-point "passes/path/PassHeader.clp")
  (pass-name paths)
  (pass-description "Generate the set of paths through a given function")
  (pass-type Function)
  (need-loops TRUE)
  (need-regions TRUE)
  (passes paths)
  (required loops regions))

 ;([pass-valid-paths] of Pass
 ; (entry "passes/path/valid-only/PassHeader.clp")
 ; (pass-name "valid-paths")
 ; (pass-description "Generate the set of paths through user-defined valid regions in a function")
 ; (target Function))
 ;([pass-paths] of Pass
 ; (entry "passes/path/all-paths/PassHeader.clp")
 ; (pass-name "paths")
 ; (pass-description "Generate the set of all paths through all regions in a function")
 ; (target Function))

)


Added the simulator file

Added the simulator file

This file will contain all of the logic for the theoretical-architecture
emulator.

;------------------------------------------------------------------------------
;electron
;Copyright (c) 2012-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 The Adventure Engine 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.
;-------------------------------------------------------------------------------
; Simulator.clp - Defines a simple computer to be executed through an expert
;                 system. This computer is unique in that instructions declare
;                 actions instead of perform actions directly.
;
;                 The Theoretical Architecture is an 8-bit declarative
;                 processor architecture. It has an 8-bit direct address space
;                 that can be extended through the use of jump instructions.
;-------------------------------------------------------------------------------
(defclass memory-cell
  (is-a USER)
  (slot address
        (type INTEGER)
        (range 0 ?VARIABLE))
  (slot value
        (type INTEGER)
        (range 0 255)
        (default-dynamic 0)))

(defclass register
 "Represents a storage location that is \"close\" to the procesor"
  (is-a USER)
  (slot offset
        (type INTEGER)
        (range 0 255)
        (storage local)
        (default ?NONE))
  (slot value
        (type INTEGER)
        (range 0 255)
        (default-dynamic 0)))
;TODO: automate the generation of the register set

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


GLAPIConversion.clp: Added a conversation with myself about conversion

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

			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o =>))
			(object (is-a GLAPIArgument)
					  (id ?o)
					  (parent ?p))
			=>
			(modify ?fct (action make-function-builder)
					  (arguments ?p)))
;------------------------------------------------------------------------------
(defclass types::FunctionBuilder
  "Builds C functions"
  (is-a Object)
  (multislot contents))
;------------------------------------------------------------------------------
(defclass types::CLIPSFunctionBuilder
  (is-a FunctionBuilder)
  (multislot data-objects)
  (multislot variables)
  (multislot parsing-entries)
  (slot count))
;------------------------------------------------------------------------------
; So, what do we need to do to construct a single function
; 0) Generate the registration entry for the target builder
; 1) Generate the function builder (done)
; 2) Define required arguments
; 3) Figure out type conversions
; 4) Define translation code for each argument
; 5) Generate code to call the target function with the given arguments
; 6) Assemble the function together
;------------------------------------------------------------------------------
; We use EnvDefineFunction in all cases of registration
;
; For conversion of pointers, we take in a multifield from clips and convert
; that to a corresponding pointer. We can also use macros or a function to
; do the conversion, that would make this whole process a lot easier.
;
; While it goes against the standard practices of C, I am going to have this
; conversion function perform the malloc and return the pointer. It is up to
; the function that called the conversion function to clean up the pointer once
; finished.
;
; However, continually calling malloc and free is costly. We can allocate a
; pointer ahead of time and continually resize it as necessary. We could also
; define a huge block of memory and then slice it accordingly.
;
; I know this for certain, this technique will go through many iterations
; before I arrive at a valid solution (most likely).
;------------------------------------------------------------------------------
(defrule grouping-update::make-function-builder
			?fct <- (message (to grouping-update)
								  (action make-function-builder)
								  (arguments ?p))
			=>
			(modify ?fct (action build-function)
					  (arguments ?p -1))
			(make-instance of CLIPSFunctionBuilder
								(parent ?p)))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-header
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p -1))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p))
			(object (is-a GLAPIFunction)
					  (id ?p)
					  (return-type ?ret)
					  (clips-function-name ?cfn))
			=>
			(modify ?fct (arguments ?p 0))
			(modify-instance ?obj (contents
											(format nil "extern %s %s(void* theEnv) {"
													  ?ret ?cfn))))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-add-argument
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			?arg <- (object (is-a GLAPIArgument)
								 (parent ?p)
								 (index ?index)
								 (id ?argID))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p)
								 (parsing-entries $?pe)
								 (contents $?contents))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(modify-instance ?obj
								  (contents $?contents
												(format nil "//code to handle %s"
														  (send ?arg reconstitute)))))
;------------------------------------------------------------------------------
(defrule grouping-update::close-function
			(declare (salience -1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			(not (exists (object (is-a GLAPIArgument)
										(parent ?p)
										(index ?index))))
			?f <- (object (is-a CLIPSFunctionBuilder)
							  (parent ?p)
							  (contents $?contents))
			=>
			(modify ?fct (action print-function)
					  (arguments ?p))
			(modify-instance ?f (contents $?contents "}")
								  (count ?index)))
;------------------------------------------------------------------------------
(defrule grouping-update::print-built-function
			?fct <- (message (to grouping-update)
								  (action print-function)
								  (arguments ?p))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?c))
			=>
			(progn$ (?line ?c)
					  (printout t ?line crlf))
			(printout t crlf crlf)
			(retract ?fct)
			(unmake-instance ?f))
;------------------------------------------------------------------------------

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

			(modify-instance ?obj (argument-type ?type)
								  (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o =>))
			(object (is-a GLAPIArgument)
					  (id ?o)
					  (parent ?p))
			=>
			(modify ?fct (action make-function-builder)
					  (arguments ?p)))
;------------------------------------------------------------------------------
(defclass types::FunctionBuilder
  "Builds C functions"
  (is-a Object)
  (multislot contents))
;------------------------------------------------------------------------------
(defclass types::CLIPSFunctionBuilder
  (is-a FunctionBuilder)
  (multislot data-objects)
  (multislot variables)
  (multislot parsing-entries)
  (slot count))
;------------------------------------------------------------------------------
; So, what do we need to do to construct a single function
; 1) Generate the function builder (done)
; 2) Define required arguments
; 3) Figure out type conversions
; 4) Define translation code for each argument
;------------------------------------------------------------------------------
(defrule grouping-update::make-function-builder
			?fct <- (message (to grouping-update)
								  (action make-function-builder)
								  (arguments ?p))
			=>
			(modify ?fct (action build-function)
					  (arguments ?p -1))
			(make-instance of CLIPSFunctionBuilder
								(parent ?p)))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-header
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p -1))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p))
			(object (is-a GLAPIFunction)
					  (id ?p)
					  (return-type ?ret)
					  (clips-function-name ?cfn))
			=>
			(modify ?fct (arguments ?p 0))
			(modify-instance ?obj (contents
											(format nil "extern %s %s(void* theEnv) {"
													  ?ret ?cfn))))
;------------------------------------------------------------------------------
(defrule grouping-update::build-function-add-argument
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			?arg <- (object (is-a GLAPIArgument)
								 (parent ?p)
								 (index ?index)
								 (id ?argID))
			?obj <- (object (is-a CLIPSFunctionBuilder)
								 (parent ?p)
								 (parsing-entries $?pe)
								 (contents $?contents))
			=>
			(modify ?fct (arguments ?p (+ ?index 1)))
			(modify-instance ?obj
								  (contents $?contents
												(format nil "//code to handle %s"
														  (send ?arg reconstitute)))))
;------------------------------------------------------------------------------
(defrule grouping-update::close-function
			(declare (salience -1))
			?fct <- (message (to grouping-update)
								  (action build-function)
								  (arguments ?p ?index))
			(not (exists (object (is-a GLAPIArgument)
										(parent ?p)
										(index ?index))))
			?f <- (object (is-a CLIPSFunctionBuilder)
							  (parent ?p)
							  (contents $?contents))
			=>
			(modify ?fct (action print-function)
					  (arguments ?p))
			(modify-instance ?f (contents $?contents "}")
								  (count ?index)))
;------------------------------------------------------------------------------
(defrule grouping-update::print-built-function
			?fct <- (message (to grouping-update)
								  (action print-function)
								  (arguments ?p))
			?f <- (object (is-a FunctionBuilder)
							  (parent ?p)
							  (contents $?c))
			=>
			(progn$ (?line ?c)
					  (printout t ?line crlf))
			(printout t crlf crlf)
			(retract ?fct)
			(unmake-instance ?f))
;------------------------------------------------------------------------------


Fixed the get-Pointer message in wavefront-scheduling/common/Functions.clp

It should be get-pointer

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(deffunction types::symbol-to-pointer-list
				 "Converts a given list of symbols that represent InteropObjects and pulls the
				 pointer value out of it. This function assumes order is important"
				 (?list)
				 (bind ?result (create$))
				 (progn$ (?e ?list)
							(bind ?obj (instance-address *
																  (symbol-to-instance-name ?e)))
							(bind ?result (create$ ?result (send ?obj get-pointer))))
				 (return ?result))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(deffunction types::symbol-to-pointer-list
				 "Converts a given list of symbols that represent InteropObjects and pulls the
				 pointer value out of it. This function assumes order is important"
				 (?list)
				 (bind ?result (create$))
				 (progn$ (?e ?list)
							(bind ?obj (instance-address *
																  (symbol-to-instance-name ?e)))
							(bind ?result (create$ ?result (send ?obj get-Pointer))))
				 (return ?result))
;------------------------------------------------------------------------------


Updated DeclareApplicationFunctions.clp to use generic-load

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


Move the samples away from the main code branch for refactoring.
KHK.

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

(deftemplate agent-message
       (slot sender)
       (slot receivers)
       (multislot reply-to)
       (slot performative)
       (slot content)
       (slot language)
       (slot encoding)
       (slot ontology)
       (slot protocol)
       (slot conversation-id)
       (slot in-reply-to)
       (slot reply-with)
       (slot reply-by)
       (multislot user-properties)
)

(deftemplate agent-description
       (slot name)
)

(defrule incoming-message
       (agent-description
               (name ?receiver)
       )
       (agent-message
               (sender ?sender)
               (receivers ?receiver)
               (reply-to ?replyto)
               (performative ?performative)
               (content ?content)
               (language ?language)
               (encoding ?encoding)
               (ontology ?ontology)
               (protocol ?protocol)
               (conversation-id ?conversationid)
               (in-reply-to ?inreplyto)
               (reply-with ?replywith)
               (reply-by ?replyby)
               (user-properties ?userproperties)
       )
       =>
       (printout t ?receiver " received a message" crlf)
       (agent-send-message ?sender ?replyto ?performative ?content ?language ?encoding ?ontology ?protocol ?conversationid)
)
(assert (agent-description (name "you") ) )
(assert (agent-message (sender "me")(receivers "you")(reply-to "peter" "paul" "marry")(performative "yes")(content "hello")(langauge "en")(encoding "utf8")(ontology "none")(protocol "1")(conversationid "100") ) )


Added pixel creation operations in rectangle.clp

(defgeneric defrectangle)
(defgeneric quickrect)
(defgeneric defpixel)
(defgeneric pixel:nxn)
(defgeneric pixel:1x1)

(defclass Rectangle
  (is-a Pointer)
  (slot pointer-class
        (source composite)
        (default Rectangle))
  (slot x
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (slot y
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (slot bx
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (slot by
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (message-handler get-points primary))

(defmessage-handler Rectangle get-points ()
                    (create$ ?self:x ?self:y ?self:bx ?self:by))

(defmethod defrectangle
  "Creates a new rectangle object and corresponding pointer"
  ((?name SYMBOL INSTANCE-NAME)
   (?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (make-instance ?name of Rectangle
                 (x ?x)
                 (y ?y)
                 (bx ?bx)
                 (by ?by)
                 (pointer (quickrect ?x ?y ?bx ?by))))
(defmethod defrectangle
  ((?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (defrectangle (gensym*) ?x ?y ?bx ?by))

(defmethod quickrect
  ((?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (new Rectangle ?x ?y ?bx ?by))

(defmethod quickrect
  ((?mf MULTIFIELD INTEGER (>= (length$ ?mf) 4)))
  (quickrect (expand$ (subseq$ ?mf 1 4))))

(defmethod quickrect
  (($?mf MULTIFIELD INTEGER (>= (length$ ?mf) 4)))
  (quickrect ?mf))

(defmethod defpixel
  ((?name SYMBOL INSTANCE-NAME)
   (?x INTEGER)
   (?y INTEGER)
   (?factor INTEGER))
  (defrectangle ?name ?x ?y (+ ?x ?factor) (+ ?y ?factor)))

(defmethod pixel:nxn
  ((?x INTEGER)
   (?y INTEGER)
   (?n INTEGER))
  (quickrect ?x ?y (+ ?x ?n) (+ ?y ?n)))

(defmethod pixel:nxn
  ((?n INTEGER))
  (pixel:nxn 0 0 ?n))

(defmethod pixel:1x1
  ((?x INTEGER)
   (?y INTEGER))
  (pixel:nxn ?x ?y 1))

(defmethod pixel:1x1 ()
  (pixel:1x1 0 0))

(defglobal MAIN
           ?*rect:single-pixel* = (send (defrectangle rect:single-pixel 0 0 1 1) get-pointer))

(defgeneric defrectangle)
(defgeneric quickrect)

(defclass Rectangle
  (is-a Pointer)
  (slot pointer-class
        (source composite)
        (default Rectangle))
  (slot x
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (slot y
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (slot bx
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (slot by
        (type INTEGER)
        (access initialize-only)
        (storage local)
        (default ?NONE))
  (message-handler get-points primary))

(defmessage-handler Rectangle get-points ()
                    (create$ ?self:x ?self:y ?self:bx ?self:by))

(defmethod defrectangle
  "Creates a new rectangle object and corresponding pointer"
  ((?name SYMBOL INSTANCE-NAME)
   (?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (make-instance ?name of Rectangle
                 (x ?x)
                 (y ?y)
                 (bx ?bx)
                 (by ?by)
                 (pointer (quickrect ?x ?y ?bx ?by))))
(defmethod defrectangle
  ((?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (defrectangle (gensym*) ?x ?y ?bx ?by))

(defmethod quickrect
  ((?x INTEGER)
   (?y INTEGER)
   (?bx INTEGER)
   (?by INTEGER))
  (new Rectangle ?x ?y ?bx ?by))

(defmethod quickrect
  ((?mf MULTIFIELD INTEGER (>= (length$ ?mf) 4)))
  (quickrect (expand$ (subseq$ ?mf 1 4))))

(defmethod quickrect
  (($?mf MULTIFIELD INTEGER (>= (length$ ?mf) 4)))
  (quickrect ?mf))

(defglobal MAIN
           ?*rect:single-pixel* = (send (defrectangle rect:single-pixel 0 0 1 1) get-pointer))


Fixed bugs in GLAPIConversion.clp

Fixed bugs in GLAPIConversion.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.
;------------------------------------------------------------------------------
; 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")
;------------------------------------------------------------------------------
; 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)
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(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*))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name)))
			(modify ?msg (to grouping-update)
					  (action parse-arguments)
					  (arguments ?objName => $?args)))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-arguments
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::create-last-argument
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(modify ?fct (action populate-argument)
					  (arguments ?name => $?all))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-empty-parse-message
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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")
;------------------------------------------------------------------------------
; 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))
						  (slot-direct-insert$ arguments ?index ?name)
						  (return ?index))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type)
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(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*))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name)))
			(modify ?msg (to grouping-update)
					  (action parse-arguments)
					  (arguments ?objName => $?args)))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-arguments
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::create-last-argument
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(modify ?fct (action populate-argument)
					  (arguments ?name => $?all))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-empty-parse-message
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------


Added the Object class

Added the Object class

This is the base class of all objects in the project

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

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

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


Formatting PassRegistry

Formatting PassRegistry

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

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

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

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