;;; PLT Scheme Simulation Collection
;;; Copyright (c) 2005 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.
;;;

;;; process% class
;;; A process% encapsulates a process and provides an object-oriented
;;; abstraction for active simulation objects.  A process% contains
;;; arbitrary (developer specified) state information.

(define process%
  (class object%
    (public get-state get-time set-time interrupt resume)
    (field (process #f))
    (define (get-state)
      (process-state process))
    (define (get-time)
      (process-time process))
    (define (set-time time)
      (set-process-time! process time))
    (define (interrupt)
      (interrupt-process process))
    (define (resume)
      (resume-process process))
    (super-new)))

;;; (define-process-class (name superclass-expr)
;;;   class-clause
;;;   ...
;;;   body-clause)
;;;
;;; The define-process-class macro defines a new process class.
;;; If suoer-class-expr is not specified, it defaults to component%.
;;; Each class-cluse is a defined in the PLT MzLib: Libraries Manual
;;; Section 4.3 Creating Clauses.  The last item in the definition is
;;; a single expression that is the body of the encapsulated process
;;; (i.e., use begin to wrap multiple expressions).  This restriction
;;; may be relaxed in the future, but will greatly complicate the
;;; macro.
(define-syntax (define-process-class stx)
  (syntax-case stx ()
    ((define-process-class (name superclass-expr)
       class-clause
       ...
       body-expr)
     (with-syntax ((this-id (datum->syntax-object
                             (syntax define-process-class)
                             'this)))
       (syntax
        (define name
          (class superclass-expr
            (inherit get-state get-time set-time interrupt resume)
            (inherit-field process)
            class-clause
            ...
            (super-new)
            (define-process (name this-id)               
                            body-expr)
            (set! process (schedule now (name this))))))))
    ((define-process-class name
                           class-clause
                           ...
                           body-expr)
     (syntax
      (define-process-class (name process%)
                            class-clause
                            ...
                            body-expr)))))