X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=mars.scm;fp=mars.scm;h=3ead51f09ec9b19da85ae4bbba8bf6677590a72d;hp=a9ba7c54a274200769eb3d2292e2f8c224e3afca;hb=7290d31ea915ea868ca34857e62fea9133db33f8;hpb=d4f97cb3c89307474ca8eaa812b739af35c2b7f3 diff --git a/mars.scm b/mars.scm index a9ba7c5..3ead51f 100644 --- a/mars.scm +++ b/mars.scm @@ -205,24 +205,25 @@ (define (dump-prog prog) (print (prog->string prog))) - + + ;;; Executive function ;; (define (run-mars core queues steps-left) - (cond - ((<= steps-left 0) queues) ;Tie between remaining players - ((null? queues) queues) ;Everyone's dead - (else - (let* ((queue (car queues)) - (remaining-queues (cdr queues)) - (ptrs (queue-ptrs queue)) - (new-ptrs (execute-instr core (car ptrs) (queue-owner queue)))) - (if (null? new-ptrs) - (run-mars core remaining-queues (- steps-left 1)) - (begin - (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs)) - (run-mars core (append remaining-queues (list queue)) (- steps-left 1)))))))) + (if (or (<= steps-left 0) + (null? queues) + (= (length queues) 1)) + queues + (let* ((queue (car queues)) + (remaining-queues (cdr queues)) + (ptrs (queue-ptrs queue)) + (new-ptrs (execute-instr core (car ptrs) (queue-owner queue)))) + (if (null? new-ptrs) + (run-mars core remaining-queues (- steps-left 1)) + (begin + (queue-set-ptrs! queue (append (cdr ptrs) new-ptrs)) + (run-mars core (append remaining-queues (list queue)) (- steps-left 1))))))) (define (execute-instr core ptr name) ;; (print ptr "\t" (core ptr '->string) "\t(" name ")")