Got rid of one-armed ifs in the common benchmarks.

collects/tests/racket/benchmarks/common/dynamic2.sch

@@ -7,6 +7,7 @@
 ; 970215 / wdc Removed most i/o and added dynamic-benchmark.
 ; 990707 / lth Added a quote and changed the call to run-benchmark.
 ; 010404 / wdc Changed the input file path name to "dynamic-input.sch".
+; 100404 / Vincent St-Amour Got rid of one-armed ifs
 
 ;; Fritz's dynamic type inferencer, set up to run on itself
 ;; (see the end of this file).
@@ -1034,7 +1035,9 @@
 	(let ((tv-def (tvar-def tv-rep)))
 	  (asymm-link! tv-rep dynamic)
 	  (if (not (null? tv-def))
-	      (map equiv-with-dynamic! (type-args tv-def))))))
+	      (map equiv-with-dynamic! (type-args tv-def))
+              #f))
+        #f))
   '())
 ;----------------------------------------------------------------------------
 ; Polymorphic type management

collects/tests/racket/benchmarks/common/earley.sch

@@ -2,6 +2,7 @@
 
 ; $Id: earley.sch,v 1.2 1999/07/12 18:05:19 lth Exp $
 ; 990708 / lth -- changed 'main' to 'earley-benchmark'.
+; 100404 / Vincent St-Amour -- got rid of one-armed ifs
 ;
 ; (make-parser grammar lexer) is used to create a parser from the grammar
 ; description `grammar' and the lexer function `lexer'.
@@ -199,7 +200,8 @@
               (vector-set! steps i (- i nb-nts))
               (vector-set! names i (list (vector-ref nts i) 0))
               (vector-set! enders i (list i))
-              (nt-loop (- i 1)))))
+              (nt-loop (- i 1)))
+            #f))
 
         (let def-loop ((defs grammar) (conf (vector-length nts)))
           (if (pair? defs)
@@ -220,7 +222,8 @@
                           (vector-set! steps conf (- (ind head nts) nb-nts))
                           (add-conf conf head nts enders)
                           (rule-loop (cdr rules) (+ conf 1) (+ rule-num 1))))))
-                  (def-loop (cdr defs) conf))))))))
+                  (def-loop (cdr defs) conf))))
+            #f))))
 
 ; Now, for each non-terminal, compute the starters, enders and predictors and
 ; the names and steps tables.
@@ -309,7 +312,8 @@
             (if (< tail 0)
               (begin
                 (vector-set! conf-set 0 (vector-ref state 0))
-                (vector-set! state 0 conf)))))
+                (vector-set! state 0 conf))
+              #f)))
 
         (define (conf-set-adjoin* states state-num l i)
           (let ((state (vector-ref states state-num)))
@@ -321,7 +325,8 @@
                     (begin
                       (conf-set-adjoin state conf-set conf i)
                       (loop (cdr l1)))
-                    (loop (cdr l1))))))))
+                    (loop (cdr l1))))
+                #f))))
 
         (define (conf-set-adjoin** states states* state-num conf i)
           (let ((state (vector-ref states state-num)))
@@ -329,7 +334,8 @@
               (let* ((state* (vector-ref states* state-num))
                      (conf-set* (conf-set-get* state* state-num conf)))
                 (if (not (conf-set-next conf-set* i))
-                  (conf-set-adjoin state* conf-set* conf i))
+                  (conf-set-adjoin state* conf-set* conf i)
+                  #f)
                 #t)
               #f)))
 
@@ -340,7 +346,8 @@
                 (begin
                   (conf-set-adjoin state conf-set conf i)
                   (loop (conf-set-next other-set i)))
-                (loop (conf-set-next other-set i))))))
+                (loop (conf-set-next other-set i)))
+              #f)))
 
         (define (forw states state-num starters enders predictors steps nts)
 
@@ -357,7 +364,8 @@
                     (begin
                       (conf-set-adjoin state starter-set starter state-num)
                       (loop1 (cdr l)))
-                    (loop1 (cdr l))))))
+                    (loop1 (cdr l))))
+                #f))
 
             ; check for possible completion of the non-terminal `nt' to the
             ; right of the dot
@@ -370,7 +378,8 @@
                            (next-set (conf-set-get* state state-num next)))
                       (conf-set-union state next-set next conf-set)
                       (loop2 (cdr l)))
-                    (loop2 (cdr l)))))))
+                    (loop2 (cdr l))))
+                #f)))
 
           (define (reduce states state state-num conf-set head preds)
 
@@ -386,9 +395,11 @@
                         (if pred-set
                           (let* ((next (+ pred 1))
                                  (next-set (conf-set-get* state state-num next)))
-                            (conf-set-union state next-set next pred-set)))
+                            (conf-set-union state next-set next pred-set))
+                          #f)
                         (loop2 (conf-set-next conf-set i)))
-                      (loop1 (cdr l))))))))
+                      (loop1 (cdr l)))))
+                #f)))
 
           (let ((state (vector-ref states state-num))
                 (nb-nts (vector-length nts)))
@@ -404,7 +415,8 @@
                       (predict state state-num conf-set conf step starters enders)
                       (let ((preds (vector-ref predictors (+ step nb-nts))))
                         (reduce states state state-num conf-set head preds)))
-                    (loop)))))))
+                    (loop))
+                  #f)))))
 
         (define (forward starters enders predictors steps nts toks)
           (let* ((nb-toks (vector-length toks))
@@ -418,7 +430,8 @@
                 (let ((tok-nts (cdr (vector-ref toks i))))
                   (conf-set-adjoin* states (+ i 1) tok-nts i) ; scan token
                   (forw states (+ i 1) starters enders predictors steps nts)
-                  (loop (+ i 1)))))
+                  (loop (+ i 1)))
+                #f))
             states))
 
         (define (produce conf i j enders steps toks states states* nb-nts)
@@ -438,7 +451,9 @@
                                  (conf-set-adjoin** states states* j ender k))
                             (loop2 (conf-set-next ender-set k)))
                           (loop1 (cdr l))))
-                      (loop1 (cdr l)))))))))
+                      (loop1 (cdr l))))
+                  #f))
+              #f)))
 
         (define (back states states* state-num enders steps nb-nts toks)
           (let ((state* (vector-ref states* state-num)))
@@ -455,7 +470,8 @@
                           (produce conf i state-num enders steps
                                    toks states states* nb-nts)
                           (loop2 (conf-set-next conf-set i)))
-                        (loop1)))))))))
+                        (loop1))))
+                  #f)))))
 
         (define (backward states enders steps nts toks)
           (let* ((nb-toks (vector-length toks))
@@ -467,12 +483,14 @@
               (if (pair? l)
                 (let ((conf (car l)))
                   (conf-set-adjoin** states states* nb-toks conf 0)
-                  (loop1 (cdr l)))))
+                  (loop1 (cdr l)))
+                #f))
             (let loop2 ((i nb-toks))
               (if (>= i 0)
                 (begin
                   (back states states* i enders steps nb-nts toks)
-                  (loop2 (- i 1)))))
+                  (loop2 (- i 1)))
+                #f))
             states*))
 
         (define (parsed? nt i j nts enders states)

collects/tests/racket/benchmarks/common/fft.sch

@@ -5,6 +5,7 @@
 ; Created:      8-Apr-85
 ; Modified:     6-May-85 09:29:22 (Bob Shaw)
 ;               11-Aug-87 (Will Clinger)
+;               4-May-10 (Vincent St-Amour)
 ; Language:     Scheme
 ; Status:       Public Domain
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -51,7 +52,8 @@
       (if (< i n)
           (begin (set! m (+ m 1))
                  (set! i (+ i i))
-                 (loop))))
+                 (loop))
+          #t))
     (cond ((not (= n (expt 2 m)))
            (error "array size not a power of two.")))
     ;; interchange elements in bit-reversed order

collects/tests/racket/benchmarks/common/graphs.sch

@@ -2,6 +2,7 @@
 ; and to expand the four macros below.
 ; Modified 11 June 1997 by Will Clinger to eliminate assertions
 ; and to replace a use of "recur" with a named let.
+; Modified 4 May 2010 by Vincent St-Amour to get rid of one-armed ifs
 ;
 ; Performance note: (graphs-benchmark 7) allocates
 ;   34509143 pairs
@@ -71,7 +72,8 @@
           (let loop ((i 1))
             (if (< i size) (begin               ; [wdc - was when]
                              (vector-set! x i (f i))
-              (loop (+ i 1)))))
+                             (loop (+ i 1)))
+                #t))
           x))))
 
 (define vector-fold
@@ -616,7 +618,9 @@
 					    (lambda (t)
 						(if (vector-ref from-m t)
                                                    (begin ; [wdc - was when]
-						    (vector-set! from-f t #t)))))))))))))
+						    (vector-set! from-f t #t))
+                                                   #t))))
+                                       #t)))))))
 	    res)))
 
 

collects/tests/racket/benchmarks/common/maze2.sch

@@ -12,6 +12,7 @@
 ; By Ozan Yigit
 
 ;;; Rehacked by Olin 4/1995.
+;;; One-armed ifs removed by Vincent St-Amour 5/5/2010
 
 (define (random-state n)
   (vector n))
@@ -125,7 +126,8 @@
                    (let ((next (vector-ref x 1)))        
                      (cond ((not (eq? r next))
                             (vector-set! x 1 r)
-                            (lp next))))))
+                            (lp next)))))
+                 #t)
              r)))))                     ; Then return r.
 
 (define (set-equal? s1 s2) (eq? (get-set-root s1) (get-set-root s2)))
@@ -238,7 +240,8 @@
                      (wall-mask (bitwise-not (wall:bit wall))))
                  (union! set1 set2)
                  (set-cell:walls c1 (bitwise-and walls wall-mask))
-                 (if (= (set-size set1) ncells) (quit #f))))))
+                 (if (= (set-size set1) ncells) (quit #f) #t))
+               #t)))
        walls))))
 
 
@@ -255,7 +258,8 @@
     (set-cell:parent node parent)
     (do-children (lambda (child)
                    (if (not (eq? child parent))
-                       (search child node)))
+                       (search child node)
+                       #t))
                  maze node)))
 
 ;;; Move the root to NEW-ROOT.
@@ -264,7 +268,7 @@
   (let lp ((node new-root) (new-parent #f))
     (let ((old-parent (cell:parent node)))
       (set-cell:parent node new-parent)
-      (if old-parent (lp old-parent node)))))
+      (if old-parent (lp old-parent node) #t))))
 
 ;;; How far from CELL to the root?
 
@@ -436,10 +440,12 @@
           ((<= y 1))    ; Don't do bottom row.
           (let ((hex (href harr x y)))
             (if (not (zero? x))
-                (add-wall hex (href harr (- x 3) (- y 1)) south-west))
+                (add-wall hex (href harr (- x 3) (- y 1)) south-west)
+                #t)
             (add-wall hex (href harr x (- y 2)) south)
             (if (< x xmax)
-                (add-wall hex (href harr (+ x 3) (- y 1)) south-east)))))
+                (add-wall hex (href harr (+ x 3) (- y 1)) south-east)
+                #t))))
 
     ;; Do the SE and SW walls of the odd columns on the bottom row.
     ;; If the rightmost bottom hex lies in an odd column, however,
@@ -449,14 +455,16 @@
           ;; Do rightmost odd col.
           (let ((rmoc-hex (href harr rmoc-x 1)))
             (if (< rmoc-x xmax) ; Not  a corner -- do E wall.
-                (add-wall rmoc-hex (href harr xmax 0) south-east))
+                (add-wall rmoc-hex (href harr xmax 0) south-east)
+                #t)
             (add-wall rmoc-hex (href harr (- rmoc-x 3) 0) south-west))
 
           (do ((x (- rmoc-x 6) ; Do the rest of the bottom row's odd cols.
                   (- x 6)))
               ((< x 3)) ; 3 is X coord of leftmost odd column.
             (add-wall (href harr x 1) (href harr (- x 3) 0) south-west)
-            (add-wall (href harr x 1) (href harr (+ x 3) 0) south-east))))
+            (add-wall (href harr x 1) (href harr (+ x 3) 0) south-east)))
+        #t)
 
     (list->vector walls)))
 
@@ -504,28 +512,31 @@
          (nc (harr:ncols harr))
          (maxy (* 2 (- nr 1)))
          (maxx (* 3 (- nc 1))))
-    (if (not (bit-test walls south-west)) (proc (href harr (- x 3) (- y 1))))
+    (if (not (bit-test walls south-west)) (proc (href harr (- x 3) (- y 1))) #t)
-    (if (not (bit-test walls south))      (proc (href harr x       (- y 2))))
+    (if (not (bit-test walls south))      (proc (href harr x       (- y 2))) #t)
-    (if (not (bit-test walls south-east)) (proc (href harr (+ x 3) (- y 1))))
+    (if (not (bit-test walls south-east)) (proc (href harr (+ x 3) (- y 1))) #t)
 
     ;; NW neighbor, if there is one (we may be in col 1, or top row/odd col)
     (if (and (> x 0)    ; Not in first column.
              (or (<= y maxy)            ; Not on top row or
                  (zero? (modulo x 6)))) ; not in an odd column.
         (let ((nw (href harr (- x 3) (+ y 1))))
-          (if (not (bit-test (cell:walls nw) south-east)) (proc nw))))
+          (if (not (bit-test (cell:walls nw) south-east)) (proc nw) #t))
+        #t)
 
     ;; N neighbor, if there is one (we may be on top row).
     (if (< y maxy)              ; Not on top row
         (let ((n (href harr x (+ y 2))))
-          (if (not (bit-test (cell:walls n) south)) (proc n))))
+          (if (not (bit-test (cell:walls n) south)) (proc n) #t))
+        #t)
 
     ;; NE neighbor, if there is one (we may be in last col, or top row/odd col)
     (if (and (< x maxx) ; Not in last column.
              (or (<= y maxy)            ; Not on top row or
                  (zero? (modulo x 6)))) ; not in an odd column.
         (let ((ne (href harr (+ x 3) (+ y 1))))
-          (if (not (bit-test (cell:walls ne) south-west)) (proc ne))))))
+          (if (not (bit-test (cell:walls ne) south-west)) (proc ne) #t))
+        #t)))
 
 
 
@@ -612,7 +623,8 @@
       (write-ch (dot/space harr (- nrows 1) (+ c 1)))
       (write-ch #\\))
     (if (odd? ncols)
-        (write-ch (if (= entrance (- ncols 1)) #\space #\_)))
+        (write-ch (if (= entrance (- ncols 1)) #\space #\_))
+        #t)
 ;   (newline)
     (write-ch #\newline)
 

collects/tests/racket/benchmarks/common/nqueens.sch

@@ -1,5 +1,6 @@
 ;;; NQUEENS -- Compute number of solutions to 8-queens problem.
 ;; 2006/08 -- renamed `try' to `try-it' to avoid Bigloo collision (mflatt)
+;; 2010/04 -- got rid of the one-armed id (stamourv)
 
 (define trace? #f)
 
@@ -12,7 +13,7 @@
   (define (try-it x y z)
     (if (null? x)
       (if (null? y)
-        (begin (if trace? (begin (write z) (newline))) 1)
+        (begin (if trace? (begin (write z) (newline)) #t) 1)
         0)
       (+ (if (ok? (car x) 1 z)
            (try-it (append (cdr x) y) '() (cons (car x) z))

collects/tests/racket/benchmarks/common/scheme2.sch

@@ -85,9 +85,11 @@
 
 (define (variable x)
   (if (not (symbol? x))
-    (scheme-error "Identifier expected" x))
+    (scheme-error "Identifier expected" x)
+    #t)
   (if (memq x scheme-syntactic-keywords)
-    (scheme-error "Variable name can not be a syntactic keyword" x)))
+    (scheme-error "Variable name can not be a syntactic keyword" x)
+    #t))
 
 (define (shape form n)
   (let loop ((form form) (n n) (l form))
@@ -137,7 +139,8 @@
               (comp-quasiquotation-list form (- level 1) env)))
            ((eq? (car form) 'unquote-splicing)
             (if (= level 1)
-              (scheme-error "Ill-placed 'unquote-splicing'" form))
+              (scheme-error "Ill-placed 'unquote-splicing'" form)
+              #t)
             (comp-quasiquotation-list form (- level 1) env))
            (else
             (comp-quasiquotation-list form level env))))
@@ -268,7 +271,8 @@
   (let ((pattern (cadr expr)))
     (let ((name (if (pair? pattern) (car pattern) pattern)))
       (if (not (symbol? name))
-        (scheme-error "Identifier expected" name))
+        (scheme-error "Identifier expected" name)
+        #t)
       name)))
 
 (define (definition-value expr)
@@ -672,7 +676,8 @@
         (vector-set! x 3 c)
         (let loop ((n nb-vars) (x x) (i 4) (l d))
           (if (<= i n)
-            (begin (vector-set! x i (car l)) (loop n x (+ i 1) (cdr l)))))
+            (begin (vector-set! x i (car l)) (loop n x (+ i 1) (cdr l)))
+            #t))
         (body x)))))
 
 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -769,7 +774,8 @@
       (vector-set! x 0 rte)
       (let loop ((x x) (i 1) (l vals))
         (if (pair? l)
-          (begin (vector-set! x i ((car l) x)) (loop x (+ i 1) (cdr l)))))
+          (begin (vector-set! x i ((car l) x)) (loop x (+ i 1) (cdr l)))
+          #t))
       (body x))))
 
 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

collects/tests/racket/benchmarks/common/triangle.sch

@@ -29,7 +29,8 @@
   (cond ((= depth 14)
          (let ((lp (last-position)))
            (if (not (member lp *final*))
-             (set! *final* (cons lp *final*))))
+             (set! *final* (cons lp *final*))
+             #t))
          (set! *answer*
                (cons (cdr (vector->list *sequence*)) *answer*))
          #t)