#lang scheme
;;; PLT Scheme Simulation Collection
;;; process.ss
;;; Copyright (c) 2004-2008 M. Douglas Williams
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;;; 02111-1307 USA.
;;;
;;; -------------------------------------------------------------------
;;;
;;; This file implements process definitions.
;;;
;;; Version  Date      Description
;;; 0.1.0    10/16/04  The implementation of process definitions.
;;;                    (Doug Williams)
;;; 0.1.1    06/28/05  Incomplete process class implementation.  Added
;;;                    process constructor.  (Doug Williams)
;;; 0.1.2    07/12/05  Added continuous simulation.  (Doug Williams)
;;; 1.0.0    02/24/06  Added support for linked events and priorities.
;;;                    (Doug Williams)
;;; 1.0.1    04/04/07  Added support for process monitors. (Doug
;;;                    Williams)
;;; 3.0.0    06/24/08  Updated for V4.0.  (Doug Williams)
;;; 3.0.1    11/27/08  Converted to a module.  (Doug Williams)

(require "simulation-environment.ss"
         "event.ss")

(provide (all-defined-out))

;;; Process definition structure
;;; Index  Field          Description
;;;   0    name           symbol naming the process class
;;;   1    body-function  function implementing the process
;;; v-- process classes ----------------------------------------------v
;;;   2    make           function to construct process instances
(define-values (struct:process-def
                process-def-constructor
                process-def?
                process-def-field-ref
                set-process-def-field!)
  (make-struct-type 'process-def #f 3 0))

;;; Process definition, name field
(define process-def-name
  (make-struct-field-accessor process-def-field-ref 0 'name))

(define set-process-def-name!
  (make-struct-field-mutator set-process-def-field! 0 'name))

;;; Process definition, body-function field
(define process-def-body-function
  (make-struct-field-accessor process-def-field-ref 1 'body-function))

(define set-process-def-body-function!
  (make-struct-field-mutator set-process-def-field! 1 'body-function))

;;; Process definition, make field
(define process-def-make
  (make-struct-field-accessor process-def-field-ref 2 'make))

(define set-process-def-make!
  (make-struct-field-mutator set-process-def-field! 2 'make))

;;; make-process-def: symbol x procedure -> process-def
;;; Create a process definition and associate it with the synbol
;;; naming the process.
(define (make-process-def name body-function make)
  (process-def-constructor name body-function make))

;;; Process structure (represents a process instance)
;;; Index  Field        Description
;;;   0    process-def  process definition structure
;;;   1    event        the event representing the process execution
;;;   2    state        the state of the process
;;;   3    monitor      monitor function
;;; v-- continuous simulations ---------------------------------------v
;;;   4    continuous-variables
;;;   5    terminating-condition
;;;   6    differentiation-function
(define-values (struct:process
                process-constructor
                process?
                process-field-ref
                set-process-field!)
  (make-struct-type 'process #f 7 0))

;;; Process structure, process-def field
(define process-process-def
  (make-struct-field-accessor process-field-ref 0 'process-def))

(define set-process-process-def!
  (make-struct-field-mutator set-process-field! 0 'process-def))

;;; Process structure, event field
(define process-event
  (make-struct-field-accessor process-field-ref 1 'event))

(define set-process-event!
  (make-struct-field-mutator set-process-field! 1 'event))

;;; Process structure, state field
;;; State field
;;; Index  State
;;;  -1    terminated
;;;   0    created
;;;   1    active
;;;   2    waiting/working
;;;   3    working/continuously
;;;   4    delayed
;;;   5    interrupted
;;;   6    suspended

(define PROCESS-TERMINATED -1)
(define PROCESS-CREATED 0)
(define PROCESS-ACTIVE 1)
(define PROCESS-WAITING/WORKING 2)
(define PROCESS-WORKING-CONTINUOUSLY 3)
(define PROCESS-DELAYED 4)
(define PROCESS-INTERRUPTED 5)
(define PROCESS-SUSPENDED 6)

(define process-state
  (make-struct-field-accessor process-field-ref 2 'state))

(define set-process-state!
  (make-struct-field-mutator set-process-field! 2 'state))

;;; Process structure, monitor field
(define process-monitor
  (make-struct-field-accessor process-field-ref 3 'monitor))

(define set-process-monitor!
  (make-struct-field-mutator set-process-field! 3 'monitor))

;;; Process structure, continuous-variables field
(define process-continuous-variables
  (make-struct-field-accessor process-field-ref 4 'continuous-variables))

(define set-process-continuous-variables!
  (make-struct-field-mutator set-process-field! 4 'continuous-variables))

;;; Process structure, terminating-condition field
(define process-terminating-condition
  (make-struct-field-accessor process-field-ref 5 'termination-condition))

(define set-process-terminating-condition!
  (make-struct-field-mutator set-process-field! 5 'terminating-condition))

;;; Process structure, differentiation-function field
(define process-differentiation-function
  (make-struct-field-accessor process-field-ref 6 'differentiation-function))

(define set-process-differentiation-function!
  (make-struct-field-mutator set-process-field! 6 'differentiation-function))

;;; process-name: process? -> string?
;;; Shortcut function to return the process name of a process instance from
;;; the process definition.
(define (process-name process)
  (process-def-name (process-process-def process)))

;;; process-time: process? -> real?
;;; Shortcut function to return the time the process will be reactivated.  This
;;; is only valid if the process is in the PROCESS-WAITING/WORKING state.
(define (process-time process)
  (event-time (process-event process)))

;;; set-process-time! process x real?
;;; SHortcut function to set the time the process will be reactivated.  This
;;; is only valid if the process is in the PROCESS-WAITING/WORKING state.
(define (set-process-time! process time)
  (set-event-time! (process-event process) time))

;;; make-process: symbol x list -> process
;;; Create and return a process instance.
(define (make-process process-def arguments)
  (let ((process ((process-def-make process-def)
                  process-def          ; process definition structure
                  #f                   ; event (set below)
                  PROCESS-CREATED      ; state - created
                  #f                   ; monitor
                  '()                  ; continuous-variables
                  #f                   ; terminating-condition
                  #f)))                ; differentiation-function
    ;; Create the event representing the process execution
    (set-process-event! process
                        (make-event
                         +inf.0
                         -inf.0
                         process
                         (process-def-body-function process-def)
                         arguments))
    process))

;;; define-process macro
;;; Syntax for defining a process.  It also creates a self variable
;;; that is lexically bound to the process instance withing the process
;;; body.  The code follows the example in the PLT Scheme Reference
;;; to create the self variable in the calling environment.
(define-syntax (define-process stx)
  (syntax-case stx ()
    ((define-process (name . arguments)
       body ...)
     (with-syntax ((self (datum->syntax
                          (syntax define-process)
                          'self)))
       (syntax (define name (make-process-def
                             'name
                             (lambda arguments
                               (let ((self (current-simulation-process)))
                                 body ...))
                             process-constructor)))
       ))))