separated out the list of worlds from universeState

svn: r13055

collects/2htdp/private/universe.ss

@@ -31,7 +31,8 @@
   (last-mixin
    (clock-mixin
     (class* object% (start-stop<%>) (inspect #f) (super-new)
-      (init-field        ;; type Result = (make-bundle Universe [Listof Mail])
+      (init-field        ;; type Result
+                         ; = (make-bundle [Listof World] Universe [Listof Mail])
        universe0         ;; the initial state of the universe
        on-new            ;; Universe World -> Result
        on-msg            ;; Universe World Message -> Result
@@ -56,8 +57,9 @@
           (define (pname a ...) 
             (define (handler e) (stop! e))
             (with-handlers ([exn? handler])
-              (define r (check-state-x-mail 'name (name universe a ...)))
+              (define r (check-state-x-mail 'name (name worlds universe a ...)))
               (define u (bundle-state r))
+              (set! worlds (bundle-low r))
               (set! universe u)
               (unless (boolean? to-string) (send gui add (to-string u)))
               (broadcast (bundle-mails r))))))
@@ -68,9 +70,9 @@
       
       (def/cback private (pnew world) ppnew)
       
-      (define/private (ppnew uni p)
+      (define/private (ppnew low uni p)
         (world-send p 'okay)
-        (on-new uni p))
+        (on-new low uni p))
       
       (def/cback public (ptock) tick)
       
@@ -80,8 +82,9 @@
       (define/private (check-state-x-mail tag r)
         (with-handlers ((exn? (lambda (x) (stop! x))))
           (define s (format "expected from ~a, given: " tag))
+          (define f "(make-bundle [Listof World] Universe [Listof Mail]) ~a~e")
           (unless (bundle? r) 
-            (error tag (format "(make-bundle Universe [Listof Mail]) ~a~e" s r)))
+            (error tag (format f s r)))
           r))
       
       ;; -----------------------------------------------------------------------
@@ -109,7 +112,7 @@
               (match next
                 [(cons 'REGISTER info)
                  (let* ([w (create-world in (second in-out) info)])
-                   (set! worlds (cons w worlds))
+                   ; (set! worlds (cons w worlds))
                    (pnew w)
                    (send gui add (format "~a signed up" info))
                    (loop))]
@@ -334,24 +337,30 @@
 ;                              
 
 (provide
- ;; type Bundle = (make-bundle Universe [Listof Mail]) 
+ ;; type Bundle = (make-bundle [Listof World] Universe [Listof Mail]) 
  ;; type Mail = (make-mail World S-expression)
- make-bundle ;; Universe [Listof Mail] -> Bundle 
+ make-bundle ;; [Listof World] Universe [Listof Mail] -> Bundle 
  bundle?     ;; is this a bundle? 
  make-mail   ;; World S-expression -> Mail 
  mail?       ;; is this a real mail? 
  )
 
-(define-struct bundle (state mails) #:transparent)
+(define-struct bundle (low state mails) #:transparent)
 
 (set! make-bundle
       (let ([make-bundle make-bundle])
-        (lambda (state mails)
+        (lambda (low state mails)
-          (check-arg 'make-bundle (list? mails) "list [of mails]" "second" mails)
+          (check-arg-list 'make-bundle low world? "world" "first")
-          (for-each (lambda (c) 
+          (check-arg-list 'make-bundle mails mail? "mail" "third")
-                      (check-arg 'make-bundle (mail? c) "mail" "(elements of) second" c))
+          (make-bundle low state mails))))
-                    mails)
+
-          (make-bundle state mails))))
+;; Symbol Any (Any -> Boolean) String String -> Void 
+;; raise a TP exception if low is not a list of world? elements 
+(define (check-arg-list tag low world? msg rank)
+  (check-arg tag (list? low) (format "list [of ~as]" msg) rank low)
+  (for-each (lambda (c) 
+              (check-arg tag (world? c) msg (format "(elements of) ~a" rank) c))
+            low))
 
 (define-struct mail (to content) #:transparent)
 

collects/2htdp/universe.ss

@@ -231,9 +231,9 @@
  world1    ;; sample worlds 
  world2
  world3
- ;; type Bundle = (make-bundle Universe [Listof Mail]) 
+ ;; type Bundle = (make-bundle [Listof World] Universe [Listof Mail]) 
  ;; type Mail = (make-mail World S-expression)
- make-bundle ;; Universe [Listof Mail] -> Bundle 
+ make-bundle ;; [Listof World] Universe [Listof Mail] -> Bundle 
  bundle?     ;; is this a bundle? 
  make-mail   ;; World S-expression -> Mail 
  mail?       ;; is this a real mail? 
@@ -254,10 +254,10 @@
 ;;    in the console 
 
 (define-keywords UniSpec
-  [on-new (function-with-arity 2)]
+  [on-new (function-with-arity 3)]
-  [on-msg (function-with-arity 3)]
+  [on-msg (function-with-arity 4)]
-  [on-disconnect (function-with-arity 2)]
+  [on-disconnect (function-with-arity 3)]
-  [to-string (function-with-arity 1)])
+  [to-string (function-with-arity 2)])
 
 (define-syntax (universe stx)
   (syntax-case stx ()
@@ -297,15 +297,15 @@
 ;; (World World -> U) (U World Msg) -> U
 (define (universe2 create process)
   ;; UniState = '() | (list World) | Universe
-  ;; UniState World -> (cons UniState [Listof (list World S-expression)])
+  ;; [Listof World] UniState World -> (cons UniState [Listof (list World S-expression)])
-  (define (nu s p)
+  (define (nu s x p)
     (cond
-      [(null? s) (make-bundle (list p) '())]
+      [(null? s) (make-bundle (list p) '* '())]
-      [(not (pair? s)) (make-bundle s '())]
+      [(not (pair? s)) (make-bundle s '* '())]
       [(null? (rest s)) (create (first s) p)]
       [else (error 'create "a third world is signing up!")]))
   (universe '() 
             (on-new nu)
             (on-msg process)
             #;
-            (on-tick (lambda (u) (printf "hello!\n") (list u)) 1)))
+            (on-tick (lambda (u x) (printf "hello!\n") (list u)) 1)))