20-CS-4003-001 Organization of Programming Languages Fall 2017
Object Oriented Style

Lambda calculus, Type theory, Formal semantics, Program analysis

    Prev     Next     All lectures        Code

Doctor's Office Simulation

The state of execution consists of an event queue, a doctor pool queue (for available doctors), and a patient queue (for patients waiting to be paired with doctors). Actions associated with state changes are encapsulated in the state class below. These actions depend on the current event that is taken from the event queue. Names and brief description appear in the comments below. Add the code below to that of the previous slides and run like this:
  prompt> res4
  ;Value: 
  (initial-state: 
   (eventq: 
     ((event: time-to-sick-for-patient jack is 9) 
      (event: time-to-sick-for-patient john is 12) 
      (event: time-to-sick-for-patient jill is 26)) 
    patientq: () 
    doctorq:
     ((doctor: lisa *unassigned*) 
      (doctor: larry *unassigned*) 
      (doctor: lory *unassigned*))))
Here is the code to add:
;; state consists of an event Q, a doctor pool queue, a patient waiting queue
(define state-maker
  (lambda (eventQ patientQ doctorQ)
    (lambda msg
      (case (1st msg)
        ('show 
           (list 'eventQ: (eventQ 'show) 'patientQ: (patientQ 'show)
                 'doctorQ: (doctorQ 'show)))
        ;; ----------------------------------- Tests -------------------
        ('doctorQ-empty (doctorQ 'empty))
        ('patientQ-empty (patientQ 'empty))
        ;; ----------------------------------- Initialize queues -------
        ('pat-sick-evt
           (let ((event (event-maker (2nd msg) '() (3rd msg))))
             (state-maker (eventQ 'insert event) patientQ doctorQ)))
        ('stop-event
           (let ((event (event-maker '() '() 300)))
             (state-maker (eventQ 'insert event) patientQ doctorQ)))
        ('doctor-enters-pool
           (state-maker eventQ patientQ (doctorQ 'enqueue (2nd msg))))
        ;; ----------------------------------- Pair and release --------
        ('pair-doc-pat ;; patient enters room, there is no line, doctor avail
           (let* ((doc (doctorQ 'peek)) 
                  (pat ((2nd msg) 'get-patient))
                  (evt (event-maker pat doc (+ (3rd msg) (rand (3rd msg))))))
             (state-maker (eventQ 'insert evt) patientQ (doctorQ 'dequeue))))
        ('pair-doc-pat-from-waiting-room ;; waiting patient is paired with doc
           (let* ((doc ((2nd msg) 'get-doctor)) 
                  (pat (patientQ 'peek))
                  (time ((2nd msg) 'time))
                  (evt (event-maker pat doc (+ time (rand time)))))
             (state-maker (eventQ 'insert evt) (patientQ 'dequeue) doctorQ)))
        ('release-patient-from-event  ;; patient will become sick again
           (let* ((pat ((2nd msg) 'get-patient))
                  (time ((2nd msg) 'time))
                  (evt (event-maker pat '() (+ time (rand time)))))
             (state-maker (eventQ 'insert evt) patientQ doctorQ)))
        ('enqueue-patient-from-event ;; patient enters room, no doctor avail
           (let ((pat ((2nd msg) 'get-patient)))
             (state-maker eventQ (patientQ 'enqueue pat) doctorQ)))
        ('enqueue-doctor-from-event ;; doctor becomes avail, no patient waiting
           (let ((doc ((2nd msg) 'get-doctor)))
             (state-maker eventQ patientQ (doctorQ 'enqueue doc))))
        ;; ----------------------------------- Get next event ----------
        ('get-next-event
           (cons (eventQ 'peek) 
                 (state-maker (eventQ 'dequeue) patientQ doctorQ)))
        (else (error msg 'no-such-method-in-state-maker))))))

(define res4
  (let* 
    ((state (state-maker (queue-maker '()) (queue-maker '()) (queue-maker '())))
     (state (state 'pat-sick-evt (patient-maker 'John 0) 12))
     (state (state 'pat-sick-evt (patient-maker 'Jill 0) 26))
     (state (state 'pat-sick-evt (patient-maker 'Jack 0) 9))
     (state (state 'doctor-enters-pool (doctor-maker 'Lisa)))
     (state (state 'doctor-enters-pool (doctor-maker 'Larry)))
     (state (state 'doctor-enters-pool (doctor-maker 'Lory))))
    (list 'initial-state: (state 'show))))