#lang scheme/base
;; Simplified Simulation System

;; Event definition and scheduling

;; The event list is maintained in ascending order - the first item of
;; the list is the next event to be executed.
(define *event-list* '())

;; Each event has a time the event is to be executed, the function to
;; be executed, and the (evaluated) arguments to the function.
(define-struct event (time function arguments) #:mutable)

;; schedule: event -> void
;; Add an event to the event list.
(define (schedule event)
  (set! *event-list* (event-schedule event *event-list*)))

;; event-schedule: event x list of events -> list of events
;; Return a new list of events corresponding to the given avent added
;; to the given list of events.
(define (event-schedule event event-list)
  (cond ((null? event-list)
         (list event))
        ((< (event-time event)
            (event-time (car event-list)))
         (cons event event-list))
        (else
         (cons (car event-list)
               (event-schedule event (cdr event-list))))))

;; Simulation control routines

;; Global simulation control variables
(define *time* 0.0)            ; current simulation time
(define *event* #f)            ; currently executing event
(define *loop-exit* #f)        ; main loop exit continuation
(define *loop-next* #f)        ; main loop next continuation

;; wait/work: real -> void
;; Simulate the delay while work is being done.  Add an event to
;; execute the current continuation to the event list.
(define (wait/work delay)
  (let/cc continue
    ;; Reuse the current event - it would become garbage anyway
    (set-event-time! *event* (+ *time* delay))
    (set-event-function! *event* continue)
    (set-event-arguments! *event* '())
    (schedule *event*)
    ;; Done with this event
    (set! *event* #f)
    ;; Return to the main loop
    (*loop-next*)))

;; start-simulation: -> void
;; This is the main simulation loop.  As long as there are events to
;; be executed (or the simulation is explicitly stopped): remove the
;; next event from the event list, advance the clock to the time of
;; the event, and apply the event's functions to it's arguments.
(define (start-simulation)
  (let/ec exit
    ;; Save the main loop exit continuation
    (set! *loop-exit* exit)
    ;; Main loop
    (let loop ()
      ;; Exit if no more events
      (when (null? *event-list*)
        (exit))
      (let/cc next
        ;; Save the main loop next continuation
        (set! *loop-next* next)
        ;; Execute the next event
        (set! *event* (car *event-list*))
        (set! *event-list* (cdr *event-list*))
        (set! *time* (event-time *event*))
        (apply (event-function *event*)
               (event-arguments *event*)))
      (loop))))

;; stop-simulation: -> void
;; Stop the execution of the current simulation (by jumping to its
;; exit continuation).
(define (stop-simulation)
  (*loop-exit*))

;; Random Distributions (to remove external dependencies)

;; random-float -> real
;; Returns a random real in (0.0, 1.0].
(define (random-float)
  (/ (exact->inexact (random 2147483647))
     2147483648.0))

;; random-flat: real x real -> real
;; Returns a random real number from a uniform distribution between a
;; and b.
(define (random-flat a b)
  (+ a (* (random-float) (- b a))))

;; random-exponential: real -> real
;; Returns a random real number from an exponential distribution with
;; mean mu.
(define (random-exponential mu)
  (* (- mu) (log (random-float))))

;; Example Simulation Model

;; generator: integer -> void
;; Process to generate n customers arriving into the system.
(define (generator n)
  (do ((i 0 (+ i 1)))
      ((= i n) (void))
    (wait/work (random-exponential 4.0))
    (schedule (make-event *time* customer (list i)))))

;; customer: integer -> void
;; The ith customer into the system.  The customer is in the system
;; 2 to 10 minutes and then leaves.
(define (customer i)
  (printf "~a: customer ~a enters~n" *time* i)
  (wait/work (random-flat 2.0 10.0))
  (printf "~a: customer ~a leaves~n" *time* i))

;; run-simulation: integer
;; Run the simulation for n customers (or until explicitly stopped at
;; some specified time).
(define (run-simulation n)
  ;; Reset the time and the event list
  (set! *time* 0.0)
  (set! *event-list* '())
  ;; Schedule the customer generator
  (schedule (make-event 0.0 generator (list n)))
  ;; Stop the simulation at the specified time (optional)
  ;;(schedule (make-event 50.0 stop-simulation '()))
  ;; Start the simulation main loop
  (start-simulation))

;; Run the simulation for 10 customers.
(run-simulation 10)