-(define (run-match . progs)
- (let* ((core (make-core CORE-SIZE INITIAL-INSTR))
- (queues (install-progs core (list challenger-prog other-prog))))
- (run-mars core queues)))
+(define (score-match spec prog1 prog2)
+ (let ((tally
+ (foldl
+ (lambda (score-a score-b)
+ (list (+ (car score-a) (car score-b))
+ (+ (cadr score-a) (cadr score-b))))
+ (list 0 0)
+ (let loop ((remaining (spec-games-per-match spec)))
+ (loop (- remaining 1))))))
+ `((,(prog-name prog1 ,(car tally)))
+ (,(prog-name prog2 ,(cadr tally))))))
+
+(define (score-game spec prog1 prog2)
+ (let* ((core (make-core (spec-core-size spec) INITIAL-INSTR))
+ (queues (install-progs core (list prog1 prog2)))
+ (result (run-mars core queues (spec-game-length spec))))
+ (cond
+ ((null? result) (error "Invalid game result."))
+ ((= (length result) 1)
+ (let ((winner-name (caar result)))
+ (if (eq? winner-name name1)
+ '(3 0)
+ '(0 3))))
+ (else
+ '(1 1)))))
+
+(define (count-scores-for-progs progs)
+ (map (lambda (prog)
+ (count-scores-for-name scores (prog-name prog)))
+ progs))
+
+(define (count-scores-for-name scores name)
+ (let loop ((score 0)
+ (remaining-scores scores))
+ (if (null? remaining-scores)
+ score
+ (loop
+ (let ((this-score (car remaining-scores)))
+ (cond
+ ((eq? (caar this-score) name)
+ (loop (+ score (cadar this-score)) (cdr remaining-scores)))
+ ((eq? (caadr this-score) name)
+ (loop (+ score (cadadr this-score)) (cdr remaining-scores)))))))))