;;;
;;; The basic bootstrap of the CLIPS based modeler 
;;;

(defmodule COMMON
    (export deffunction ?ALL)
)
(deffunction COMMON::log-narrative (?fmt $?args)
    (log-narrative-driver narrative ?fmt (expand$ ?args))
)
(deffunction COMMON::uuid-from-nll-args (?arg1 ?arg2)
    (engineering-type uuid
        (engineering-type eight-byte-array
            (extract-bits ?arg1 63 56) (extract-bits ?arg1 55 48) (extract-bits ?arg1 47 40) (extract-bits ?arg1 39 32)
            (extract-bits ?arg1 31 24) (extract-bits ?arg1 23 16) (extract-bits ?arg1 15 8) (extract-bits ?arg1 7 0)
        )
        (engineering-type eight-byte-array
            (extract-bits ?arg2 63 56) (extract-bits ?arg2 55 48) (extract-bits ?arg2 47 40) (extract-bits ?arg2 39 32)
            (extract-bits ?arg2 31 24) (extract-bits ?arg2 23 16) (extract-bits ?arg2 15 8) (extract-bits ?arg2 7 0)
        )
    )
)
(deffunction COMMON::process-from-target-device (?pid)
    ;; today we use TODO as the device session ID, but in the future we'll use
    ;; a real on via <rdar://problem/41263530> Use a real device session ID instead of "TODO"
    (engineering-type process ?pid "TODO")
)

(defmodule INPUT
    (export ?ALL)
)
(deftemplate INPUT::clock
    (slot trace-relative (type INTEGER))
)
(deftemplate INPUT::parameter
    (slot name (type SYMBOL) (default ?NONE))
    (slot value (type STRING SYMBOL INTEGER FLOAT))
)

(defmodule BB
    (import INPUT deftemplate ?ALL)
    (import COMMON deffunction ?ALL)        
    (export ?ALL)
)

(defglobal ?*target-pid* = ALL)

(defrule BB::cache-target-pid
    (parameter (name target-pid) (value ?pid))
    =>
    (bind ?*target-pid* ?pid)
)

(deffunction BB::target-pid-contains-pid (?target-pid ?pid)
    ;; ?target-pid will be ALL or SINGLE
    ;; ?pid will be some number to check against
    ;; if ?target-pid is ALL, then it automatically passes
    ;; if ?*target-pid* is ALL, then we are in All Process mode, so again
    ;;   everything would pass.
    ;; if ?target-pid is SINGLE, then ?pid needs to match the ?*target-pid* value
    (or (eq ?target-pid ALL) (eq ?*target-pid* ALL) (and (eq ?target-pid SINGLE) (eq ?pid ?*target-pid*)))
)
(deffunction BB::target-pid-contains-process (?target-pid ?process)
    (and (neq sentinel ?process) (target-pid-contains-pid ?target-pid (pid-from-process ?process)))
)
(deffunction BB::target-pid-contains-thread (?target-pid ?thread)
    (and (neq sentinel ?thread) (target-pid-contains-process ?target-pid (process-from-thread ?thread)))
)

;;;
;;; Standard preamble for CLIPS based modelers
;;;
(defmodule LAYOUT
    (import INPUT deftemplate clock)
    (export deftemplate layout-reservation open-layout-reservation close-layout-reservation)
)

(deftemplate LAYOUT::open-layout-reservation
    (slot start (type INTEGER) (default -1))  ;; -1 means use (clock (trace-relative ?t))
    (multislot category (default nil))
)

(deftemplate LAYOUT::close-layout-reservation
    (slot id (type INTEGER) (default ?NONE))
    (slot start (type INTEGER) (default ?NONE))   
    (slot end (type INTEGER) (default -1))    ;; -1 means use (clock (trace-relative ?t))
    (multislot category (default nil))
)

(deftemplate LAYOUT::layout-reservation
    (slot start (type INTEGER) (default ?NONE))
    (multislot category (default ?NONE))
    (slot id (type INTEGER) (default ?NONE))
)

(defmodule MODELER
    (import COMMON deffunction ?ALL)    
    (import INPUT deftemplate ?ALL)
    (import BB deftemplate ?ALL)
    (import BB deffunction ?ALL)
    (import LAYOUT deftemplate open-layout-reservation close-layout-reservation layout-reservation)
    (export ?ALL)
)

(defglobal ?*modeler-horizon* = 0)

(deftemplate MODELER::modeler-constants
    (slot sentinel-symbol (type SYMBOL) (default sentinel))
)
(deffacts MODELER::modeler-constants-fact
    (modeler-constants)
)

(defmodule RECORDER
    (import COMMON deffunction ?ALL)        
    (import INPUT deftemplate ?ALL)
    (import BB deftemplate ?ALL)
    (import BB deffunction ?ALL)
    (import MODELER ?ALL)
    (import LAYOUT deftemplate open-layout-reservation close-layout-reservation layout-reservation)    
)


;;;
;;; Layout UTILITY
;;;
;;; Certain types of modeling state may overlap in time, and the challenge of separating those overlaps is called
;;; layout.  A common example is when you have multiple overlapping events and you need to produce a graph, so 
;;; you need to provide a layout-id associated with each row in the output table.  No two rows with the same layout-id
;;; should have overlapping time spans.  This utility provides common logic on how to express that.


(deftemplate LAYOUT::available-layout-id
    (slot id (type INTEGER) (default ?NONE))
    (multislot category)
)

(deftemplate LAYOUT::best-layout-id
    (slot id (type INTEGER) (default ?NONE))
    (multislot category)
)

(deftemplate LAYOUT::layout-ids-in-use
    (multislot category (default ?NONE))
    (slot count (type INTEGER) (default ?NONE))
)

(defrule LAYOUT::layout-request-auto-focus
    (declare (auto-focus TRUE))
    (or (open-layout-reservation) 
        (close-layout-reservation)
    )
    =>
)

(defrule LAYOUT::open-a-layout-id "If we have a layout reservation request, give it the best open lane"
    (or ?g <- (open-layout-reservation (category $?cat) (start ?start&~-1))
        (and ?g <- (open-layout-reservation (category $?cat) (start -1))
                   (clock (trace-relative ?start))
        )
    )
    ?i <- (available-layout-id (id ?id) (category $?cat))
    ?u <- (layout-ids-in-use (category $?cat) (count ?count))
    (best-layout-id (id ?id) (category $?cat))
    =>
    (retract ?g ?i)
    (modify ?u (count (+ ?count 1)))
    (assert (layout-reservation (start ?start) (category $?cat) (id ?id)))
)

(defrule LAYOUT::bootstrap-new-category "Open up room for a new category if we detect one"
    (open-layout-reservation (category $?cat))
    (not (layout-ids-in-use (category $?cat)))
    =>
    (assert (layout-ids-in-use (category $?cat) (count 0)))
)

(defrule LAYOUT::choose-best-layout-id "If we don't have a best layout-id for a category, choose the smallest"
    (logical (available-layout-id (category $?cat) (id ?id))
             (not (available-layout-id (category $?cat) (id ?other-id&:(< ?other-id ?id))))
    )
    =>
    (assert (best-layout-id (category $?cat) (id ?id)))
)

(defrule LAYOUT::keep-an-available-id-open "Always keep an available layout-id open for each known category"
    (layout-ids-in-use (category $?cat) (count ?count))
    (not (available-layout-id (category $?cat)))
    =>
    (assert (available-layout-id (category $?cat) (id ?count)))
)

(defrule LAYOUT::release-layout-id
    (declare (salience 100))   ;; fire release rules first to make the tightest packing
    (or ?g <- (close-layout-reservation (category $?cat) (id ?id) (start ?start) (end ?end&~-1))
        (and ?g <- (close-layout-reservation (category $?cat) (start ?start) (id ?id) (end -1))
                   (clock (trace-relative ?end))
        )
    )
    ?r <- (layout-reservation (id ?id) (category $?cat) (start ?start))
    =>
    (retract ?g ?r)
    (assert (available-layout-id (category $?cat) (id ?id)))
)

(defrule LAYOUT::shrink-lane-ids-in-use
    (declare (salience -100))  ;; just a maintenance rule to get rid of unneeded records
    ?f <- (layout-ids-in-use (category $?cat) (count ?count&~0))
    (not (layout-reservation (category $?cat) (id ?id&:(eq ?id (- ?count 1)))))
    =>
    (modify ?f (count (- ?count 1)))
)

(defrule LAYOUT::compact-lane-when-possible
    (declare (salience -100))  ;; just a maintenance rule to get rid of unneeded records
    (layout-ids-in-use (category $?cat) (count ?count))
    ?f <- (available-layout-id (category $?cat) (id ?id&:(> ?id ?count)))
    (best-layout-id (id ?best-id&:(< ?best-id ?id)) (category $?cat))
    =>
    (retract ?f)
)

;;;
;;; Each module can only see it's bound tables, so we define the module specific
;;;
;;;
(deftemplate MODELER::table
	(slot table-id (type INTEGER))   ;; referred to as an table-id in other rules
	(slot side 
		(type SYMBOL)
		(allowed-values read append)
	)
)

(deftemplate MODELER::table-attribute
	(slot table-id (type INTEGER))
	(multislot has)
)

(deftemplate MODELER::pending-log
    (slot fmt (type STRING))
    (slot significance (type INTEGER))
    (multislot args)
)


(deftemplate MODELER::speculate
    (slot event-horizon (type INTEGER))
    (slot is-final (type SYMBOL) (allowed-symbols TRUE FALSE))
)