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 following shows the event-manager and process-event functions. The event-manager is just a simple loop though the list of events until a stop-event is reached. At each iteration process-event is called on the current state and event to be processed to generate a new state and new events, if necessary. Each event that is considered is placed in a list which is what the process-manager function outputs. Add the code below to that of the previous slides and run like this:
  prompt> res6
  ;Value:
  ((event: time-to-sick-for-patient jane is 295) 
   (event: time-to-release-pairing jane and lisa is 282) 
   (event: time-to-sick-for-patient jane is 277) 
   (event: time-to-sick-for-patient john is 238) 
   (event: time-to-release-pairing jacky and lisa is 238) 
   (event: time-to-sick-for-patient jacky is 236) 
   (event: time-to-release-pairing john and lory is 236) 
   (event: time-to-release-pairing jorry and lisa is 171) 
   (event: time-to-release-pairing jacky and lory is 163) 
   (event: time-to-sick-for-patient john is 162) 
   (event: time-to-sick-for-patient jacky is 159) 
   (event: time-to-release-pairing joe and lory is 146) 
   (event: time-to-sick-for-patient jorry is 138) 
   (event: time-to-sick-for-patient jim is 134) 
   (event: time-to-release-pairing jacky and lisa is 13) 
   (event: time-to-sick-for-patient joe is 8)
   (event: time-to-sick-for-patient jacky is 5)) 
Here is the code to add:
(define process-event
  (lambda (event state time)
    (case (event 'get-type)
      ('time-to-sick-for-patient
       (if (state 'doctorQ-empty)
           (state 'enqueue-patient-from-event event)
           (state 'pair-doc-pat event time)))
      ('time-to-release-pairing
       (let ((state (state 'release-patient-from-event event)))
         (if (state 'patientQ-empty)
             (state 'enqueue-doctor-from-event event)
             (state 'pair-doc-pat-from-waiting-room event)))) 
      (else (error 'process-event-no-method)))))

(define event-manager
  (lambda (pat-lst doc-lst)
    (let* ((state (initializer pat-lst doc-lst))
           (pair (state 'get-next-event))
           (cur-event (car pair))
           (cur-time (cur-event 'time))
           (cur-state (cdr pair)))
      (letrec 
        ((process-events
	  (lambda (event state time acc)
	    (if (eq? (event 'get-type) 'stop-event)
		acc
		(let* ((new-state (process-event event state time))
		       (pair (new-state 'get-next-event))
		       (cur-event (car pair))
		       (cur-time (cur-event 'time))
		       (cur-state (cdr pair)))
		  (process-events 
		   cur-event 
		   cur-state 
		   cur-time 
		   (cons (event 'show) acc)))))))
        (process-events cur-event cur-state cur-time '())))))

(define res6 (event-manager pat-lst doc-lst))