private/process-class.rkt
#lang racket
;;; Racket Simulation Collection
;;; process-class.rkt
;;; Copyright (c) 2005-2010 M. Douglas Williams
;;;
;;; This file is part of the Racket Simulation Collection.
;;;
;;; The Racket Simulation Collection 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 3 of the License,
;;; or (at your option) any later version.
;;;
;;; The Racket Simulation Collection 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 the Racket Simulation Collection.  If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; -----------------------------------------------------------------------------
;;;
;;; Version  Date      Description
;;; 3.0.0    06/24/08  Updated for V4.0. (MDW)
;;; 4.0.0    08/15/10  Converted Rackeet. (MDW)

(require "environment.rkt"
         "control.rkt"
         "syntaxes.rkt")

;;; 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%
    (super-new)
    (field (process #f))
    (define/public (get-state)
      (process-state process))
    (define/public (get-time)
      (process-time process))
    (define/public (set-time time)
      (set-process-time! process time))
    (define/public (interrupt)
      (interrupt-process process))
    (define/public (resume)
      (resume-process process))))

;;; (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
                             (syntax define-process-class)
                             'this)))
       #'(define name
           (class superclass-expr
             (super-new)
             (inherit get-state get-time set-time interrupt resume)
             (inherit-field process)
             class-clause
             ...
             (define-process (name this-id)               
               body-expr)
             (set! process (schedule now (name this)))))))
  ((define-process-class name
     class-clause
     ...
     body-expr)
   #'(define-process-class (name process%)
       class-clause
       ...
       body-expr))))

;;; Module Contracts

(provide (all-defined-out))