From 20cd21440f23d5389d5859b30ad45a2eb27d0715 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 11 May 2010 18:55:29 -0400 Subject: [PATCH] Ported some more of the common benchmarks to Typed Scheme. --- .../racket/benchmarks/common/graphs-typed.rkt | 723 ++++++++++++++++++ .../racket/benchmarks/common/puzzle-typed.rkt | 199 +++++ .../racket/benchmarks/common/tak-typed.rkt | 32 + .../racket/benchmarks/common/takl-typed.rkt | 49 ++ .../racket/benchmarks/common/takr-typed.rkt | 627 +++++++++++++++ .../racket/benchmarks/common/takr2-typed.rkt | 631 +++++++++++++++ .../benchmarks/common/triangle-typed.rkt | 99 +++ 7 files changed, 2360 insertions(+) create mode 100644 collects/tests/racket/benchmarks/common/graphs-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/puzzle-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/tak-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/takl-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/takr-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/takr2-typed.rkt create mode 100644 collects/tests/racket/benchmarks/common/triangle-typed.rkt diff --git a/collects/tests/racket/benchmarks/common/graphs-typed.rkt b/collects/tests/racket/benchmarks/common/graphs-typed.rkt new file mode 100644 index 0000000000..b9b01477dc --- /dev/null +++ b/collects/tests/racket/benchmarks/common/graphs-typed.rkt @@ -0,0 +1,723 @@ +; Modified 2 March 1997 by Will Clinger to add graphs-benchmark +; 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 +; Modified 10 May 2010 by Vincent St-Amour to convert to Typed Scheme +; +; Performance note: (graphs-benchmark 7) allocates +; 34509143 pairs +; 389625 vectors with 2551590 elements +; 56653504 closures (not counting top level and known procedures) + +; End of new code. + +#lang typed/scheme/base + +;;; ==== std.ss ==== + +; (define-syntax assert +; (syntax-rules () +; ((assert test info-rest ...) +; #f))) +; +; (define-syntax deny +; (syntax-rules () +; ((deny test info-rest ...) +; #f))) +; +; (define-syntax when +; (syntax-rules () +; ((when test e-first e-rest ...) +; (if test +; (begin e-first +; e-rest ...))))) +; +; (define-syntax unless +; (syntax-rules () +; ((unless test e-first e-rest ...) +; (if (not test) +; (begin e-first +; e-rest ...))))) + +;;; ==== util.ss ==== + + +; Fold over list elements, associating to the left. +(: fold (All (X Y) ((Listof X) (X Y -> Y) Y -> Y))) +(define fold + (lambda (lst folder state) + '(assert (list? lst) + lst) + '(assert (procedure? folder) + folder) + (do ((lst lst + (cdr lst)) + (state state + (folder (car lst) + state))) + ((null? lst) + state)))) + +; Given the size of a vector and a procedure which +; sends indices to desired vector elements, create +; and return the vector. +(: proc->vector (All (X) (Integer (Integer -> X) -> (Vectorof X)))) +(define proc->vector + (lambda (size f) + '(assert (and (integer? size) + (exact? size) + (>= size 0)) + size) + '(assert (procedure? f) + f) + (if (zero? size) + (vector) + (let ((x (make-vector size (f 0)))) + (let loop ((i 1)) + (if (< i size) (begin ; [wdc - was when] + (vector-set! x i (f i)) + (loop (+ i 1))) + #t)) + x)))) + +(: vector-fold (All (X Y) ((Vectorof X) (X Y -> Y) Y -> Y))) +(define vector-fold + (lambda (vec folder state) + '(assert (vector? vec) + vec) + '(assert (procedure? folder) + folder) + (let ((len + (vector-length vec))) + (do ((i 0 + (+ i 1)) + (state state + (folder (vector-ref vec i) + state))) + ((= i len) + state))))) + +(: vec-map (All (X Y) ((Vectorof X) (X -> Y) -> (Vectorof Y)))) +(define vec-map + (lambda (vec proc) + (proc->vector (vector-length vec) + (lambda: ((i : Integer)) + (proc (vector-ref vec i)))))) + +; Given limit, return the list 0, 1, ..., limit-1. +(: giota (Integer -> (Listof Integer))) +(define giota + (lambda (limit) + '(assert (and (integer? limit) + (exact? limit) + (>= limit 0)) + limit) + (let: _-*- : (Listof Integer) + ((limit : Integer + limit) + (res : (Listof Integer) + '())) + (if (zero? limit) + res + (let ((limit + (- limit 1))) + (_-*- limit + (cons limit res))))))) + +; Fold over the integers [0, limit). +(: gnatural-fold (All (X) (Integer (Integer X -> X) X -> X))) +(define gnatural-fold + (lambda (limit folder state) + '(assert (and (integer? limit) + (exact? limit) + (>= limit 0)) + limit) + '(assert (procedure? folder) + folder) + (do ((i 0 + (+ i 1)) + (state state + (folder i state))) + ((= i limit) + state)))) + +; Iterate over the integers [0, limit). +(: gnatural-for-each (Integer (Integer -> Any) -> Null)) +(define gnatural-for-each + (lambda (limit proc!) + '(assert (and (integer? limit) + (exact? limit) + (>= limit 0)) + limit) + '(assert (procedure? proc!) + proc!) + (do: : Null + ((i : Integer 0 + (+ i 1))) + ((= i limit) '()) + (proc! i)))) + +(: natural-for-all? (Integer (Integer -> Boolean) -> Boolean)) +(define natural-for-all? + (lambda (limit ok?) + '(assert (and (integer? limit) + (exact? limit) + (>= limit 0)) + limit) + '(assert (procedure? ok?) + ok?) + (let _-*- + ((i 0)) + (or (= i limit) + (and (ok? i) + (_-*- (+ i 1))))))) + +(: natural-there-exists? (Integer (Integer -> Boolean) -> Boolean)) +(define natural-there-exists? + (lambda (limit ok?) + '(assert (and (integer? limit) + (exact? limit) + (>= limit 0)) + limit) + '(assert (procedure? ok?) + ok?) + (let _-*- + ((i 0)) + (and (not (= i limit)) + (or (ok? i) + (_-*- (+ i 1))))))) + +(: there-exists? (All (X) ((Listof X) (X -> Boolean) -> Boolean))) +(define there-exists? + (lambda (lst ok?) + '(assert (list? lst) + lst) + '(assert (procedure? ok?) + ok?) + (let _-*- + ((lst lst)) + (and (not (null? lst)) + (or (ok? (car lst)) + (_-*- (cdr lst))))))) + + +;;; ==== ptfold.ss ==== + + +; Fold over the tree of permutations of a universe. +; Each branch (from the root) is a permutation of universe. +; Each node at depth d corresponds to all permutations which pick the +; elements spelled out on the branch from the root to that node as +; the first d elements. +; Their are two components to the state: +; The b-state is only a function of the branch from the root. +; The t-state is a function of all nodes seen so far. +; At each node, b-folder is called via +; (b-folder elem b-state t-state deeper accross) +; where elem is the next element of the universe picked. +; If b-folder can determine the result of the total tree fold at this stage, +; it should simply return the result. +; If b-folder can determine the result of folding over the sub-tree +; rooted at the resulting node, it should call accross via +; (accross new-t-state) +; where new-t-state is that result. +; Otherwise, b-folder should call deeper via +; (deeper new-b-state new-t-state) +; where new-b-state is the b-state for the new node and new-t-state is +; the new folded t-state. +; At the leaves of the tree, t-folder is called via +; (t-folder b-state t-state accross) +; If t-folder can determine the result of the total tree fold at this stage, +; it should simply return that result. +; If not, it should call accross via +; (accross new-t-state) +; Note, fold-over-perm-tree always calls b-folder in depth-first order. +; I.e., when b-folder is called at depth d, the branch leading to that +; node is the most recent calls to b-folder at all the depths less than d. +; This is a gross efficiency hack so that b-folder can use mutation to +; keep the current branch. +(: fold-over-perm-tree (All (Elem BState TState) + ((Listof Elem) + (Elem BState TState + (BState TState -> TState) + (TState -> TState) + -> TState) + BState + (BState TState (TState -> TState) -> TState) + TState + -> TState))) +(define fold-over-perm-tree + (lambda (universe b-folder b-state t-folder t-state) + '(assert (list? universe) + universe) + '(assert (procedure? b-folder) + b-folder) + '(assert (procedure? t-folder) + t-folder) + (let: _-*- : TState + ((universe : (Listof Elem) + universe) + (b-state : BState + b-state) + (t-state : TState + t-state) + (accross : (TState -> TState) + (lambda (final-t-state) + final-t-state))) + (if (null? universe) + (t-folder b-state t-state accross) + (let: _-**- : TState + ((in : (Listof Elem) + universe) + (out : (Listof Elem) + '()) + (t-state : TState + t-state)) + (let*: ((first : Elem + (car in)) + (rest : (Listof Elem) + (cdr in)) + (accross : (TState -> TState) + (if (null? rest) + accross + (lambda: ((new-t-state : TState)) + (_-**- rest + (cons first out) + new-t-state))))) + (b-folder first + b-state + t-state + (lambda: ((new-b-state : BState) + (new-t-state : TState)) + (_-*- (fold out + (ann cons + (Elem (Listof Elem) + -> (Listof Elem))) + rest) + new-b-state + new-t-state + accross)) + accross))))))) + + +;;; ==== minimal.ss ==== + +(define-type Graph (Vectorof (Vectorof Boolean))) + +; A directed graph is stored as a connection matrix (vector-of-vectors) +; where the first index is the `from' vertex and the second is the `to' +; vertex. Each entry is a bool indicating if the edge exists. +; The diagonal of the matrix is never examined. +; Make-minimal? returns a procedure which tests if a labelling +; of the vertices is such that the matrix is minimal. +; If it is, then the procedure returns the result of folding over +; the elements of the automoriphism group. If not, it returns #f. +; The folding is done by calling folder via +; (folder perm state accross) +; If the folder wants to continue, it should call accross via +; (accross new-state) +; If it just wants the entire minimal? procedure to return something, +; it should return that. +; The ordering used is lexicographic (with #t > #f) and entries +; are examined in the following order: +; 1->0, 0->1 +; +; 2->0, 0->2 +; 2->1, 1->2 +; +; 3->0, 0->3 +; 3->1, 1->3 +; 3->2, 2->3 +; ... +(: make-minimal? (All (State) + (Integer -> + (Integer + Graph + ((Vectorof Integer) + Boolean + (Boolean -> Boolean) + -> Boolean) + Boolean + -> Boolean)))) +(define make-minimal? + (lambda (max-size) + '(assert (and (integer? max-size) + (exact? max-size) + (>= max-size 0)) + max-size) + (let: ((iotas : (Vectorof (Listof Integer)) + (proc->vector (+ max-size 1) + giota)) + (perm : (Vectorof Integer) + (make-vector max-size 0))) + (lambda (size graph folder state) + '(assert (and (integer? size) + (exact? size) + (<= 0 size max-size)) + size + max-size) + '(assert (vector? graph) + graph) + '(assert (procedure? folder) + folder) + (fold-over-perm-tree + (vector-ref iotas size) + (lambda: ((perm-x : Integer) + (x : Integer) + (state : Boolean) + (deeper : (Integer Boolean + -> Boolean)) + (accross : (Boolean + -> Boolean))) + (case (cmp-next-vertex graph perm x perm-x) + ((less) + #f) + ((equal) + (vector-set! perm x perm-x) + (deeper (+ x 1) + state)) + ((more) + (accross state)) + ;;(else + ;; (assert #f)) + )) + 0 + (lambda: ((leaf-depth : Integer) + (state : Boolean) + (accross : (Boolean -> Boolean))) + '(assert (eqv? leaf-depth size) + leaf-depth + size) + (folder perm state accross)) + state))))) + +; Given a graph, a partial permutation vector, the next input and the next +; output, return 'less, 'equal or 'more depending on the lexicographic +; comparison between the permuted and un-permuted graph. +(: cmp-next-vertex (Graph (Vectorof Integer) Integer Integer + -> (U 'less 'equal 'more))) +(define cmp-next-vertex + (lambda (graph perm x perm-x) + (let ((from-x + (vector-ref graph x)) + (from-perm-x + (vector-ref graph perm-x))) + (let _-*- + ((y + 0)) + (if (= x y) + 'equal + (let ((x->y? + (vector-ref from-x y)) + (perm-y + (vector-ref perm y))) + (cond ((eq? x->y? + (vector-ref from-perm-x perm-y)) + (let ((y->x? + (vector-ref (vector-ref graph y) + x))) + (cond ((eq? y->x? + (vector-ref (vector-ref graph perm-y) + perm-x)) + (_-*- (+ y 1))) + (y->x? + 'less) + (else + 'more)))) + (x->y? + 'less) + (else + 'more)))))))) + + +;;; ==== rdg.ss ==== + +(define-type RDG (Vectorof (Listof Integer))) + +; Fold over rooted directed graphs with bounded out-degree. +; Size is the number of vertices (including the root). Max-out is the +; maximum out-degree for any vertex. Folder is called via +; (folder edges state) +; where edges is a list of length size. The ith element of the list is +; a list of the vertices j for which there is an edge from i to j. +; The last vertex is the root. +(: fold-over-rdg (All (State) (Integer + Integer + (RDG State -> State) + State + -> State))) +(define fold-over-rdg + (lambda (size max-out folder state) + '(assert (and (exact? size) + (integer? size) + (> size 0)) + size) + '(assert (and (exact? max-out) + (integer? max-out) + (>= max-out 0)) + max-out) + '(assert (procedure? folder) + folder) + (let*: ((root : Integer + (- size 1)) + (edge? : Graph + (proc->vector size + (lambda: ((from : Integer)) + (ann (make-vector size #f) + (Vectorof Boolean))))) + (edges : RDG + (make-vector size '())) + (out-degrees : (Vectorof Integer) + (make-vector size 0)) + (minimal-folder : (Integer + Graph + ((Vectorof Integer) + Boolean + (Boolean -> Boolean) + -> Boolean) + Boolean + -> Boolean) + ;; make-minimal?'s type says it can return #f, but it won't + (or (make-minimal? root) + (error "can't happen"))) + (non-root-minimal? : (Integer -> Boolean) + (let ((cont + (lambda: ((perm : (Vectorof Integer)) + (state : Boolean) + (accross : (Boolean -> Boolean))) + '(assert (eq? state #t) + state) + (accross #t)))) + (lambda: ((size : Integer)) + (minimal-folder size + edge? + cont + #t)))) + (root-minimal? : ( -> Boolean) + (let ((cont + (lambda: ((perm : (Vectorof Integer)) + (state : Boolean) + (accross : (Boolean -> Boolean))) + '(assert (eq? state #t) + state) + (case (cmp-next-vertex edge? perm root root) + ((less) + #f) + ((equal more) + (accross #t)) + ;(else + ; (assert #f)) + )))) + (lambda () + (minimal-folder root + edge? + cont + #t))))) + (let: _-*- : State + ((vertex : Integer + 0) + (state : State + state)) + (cond ((not (non-root-minimal? vertex)) + state) + ((= vertex root) + '(assert + (begin + (gnatural-for-each root + (lambda (v) + '(assert (= (vector-ref out-degrees v) + (length (vector-ref edges v))) + v + (vector-ref out-degrees v) + (vector-ref edges v)))) + #t)) + (let ((reach? + (make-reach? root edges)) + (from-root + (vector-ref edge? root))) + (let: _-*- : State + ((v : Integer + 0) + (outs : Integer + 0) + (efr : (Listof Integer) + '()) + (efrr : (Listof (Vectorof Boolean)) + '()) + (state : State + state)) + (cond ((not (or (= v root) + (= outs max-out))) + (vector-set! from-root v #t) + (let ((state + (_-*- (+ v 1) + (+ outs 1) + (cons v efr) + (cons (vector-ref reach? v) + efrr) + state))) + (vector-set! from-root v #f) + (_-*- (+ v 1) + outs + efr + efrr + state))) + ((and (natural-for-all? root + (lambda (v) + (there-exists? efrr + (lambda: ((r : (Vectorof Boolean))) + (vector-ref r v))))) + (root-minimal?)) + (vector-set! edges root efr) + (folder + (proc->vector size + (lambda: ((i : Integer)) + (vector-ref edges i))) + state)) + (else + state))))) + (else + (let ((from-vertex + (vector-ref edge? vertex))) + (let _-**- + ((sv + 0) + (outs + 0) + (state + state)) + (if (= sv vertex) + (begin + (vector-set! out-degrees vertex outs) + (_-*- (+ vertex 1) + state)) + (let* ((state + ; no sv->vertex, no vertex->sv + (_-**- (+ sv 1) + outs + state)) + (from-sv + (vector-ref edge? sv)) + (sv-out + (vector-ref out-degrees sv)) + (state + (if (= sv-out max-out) + state + (begin + (vector-set! edges + sv + (cons vertex + (vector-ref edges sv))) + (vector-set! from-sv vertex #t) + (vector-set! out-degrees sv (+ sv-out 1)) + (let* ((state + ; sv->vertex, no vertex->sv + (_-**- (+ sv 1) + outs + state)) + (state + (if (= outs max-out) + state + (begin + (vector-set! from-vertex sv #t) + (vector-set! edges + vertex + (cons sv + (vector-ref edges vertex))) + (let ((state + ; sv->vertex, vertex->sv + (_-**- (+ sv 1) + (+ outs 1) + state))) + (vector-set! edges + vertex + (cdr (vector-ref edges vertex))) + (vector-set! from-vertex sv #f) + state))))) + (vector-set! out-degrees sv sv-out) + (vector-set! from-sv vertex #f) + (vector-set! edges + sv + (cdr (vector-ref edges sv))) + state))))) + (if (= outs max-out) + state + (begin + (vector-set! edges + vertex + (cons sv + (vector-ref edges vertex))) + (vector-set! from-vertex sv #t) + (let ((state + ; no sv->vertex, vertex->sv + (_-**- (+ sv 1) + (+ outs 1) + state))) + (vector-set! from-vertex sv #f) + (vector-set! edges + vertex + (cdr (vector-ref edges vertex))) + state))))))))))))) + +; Given a vector which maps vertex to out-going-edge list, +; return a vector which gives reachability. +(: make-reach? (Integer RDG -> Graph)) +(define make-reach? + (lambda (size vertex->out) + (let ((res + (proc->vector size + (lambda: ((v : Integer)) + (let: ((from-v : (Vectorof Boolean) + (make-vector size #f))) + (vector-set! from-v v #t) + (for-each + (lambda: ((x : Integer)) + (vector-set! from-v x #t)) + (vector-ref vertex->out v)) + from-v))))) + (gnatural-for-each size + (lambda: ((m : Integer)) + (let ((from-m + (vector-ref res m))) + (gnatural-for-each size + (lambda: ((f : Integer)) + (let ((from-f + (vector-ref res f))) + (if (vector-ref from-f m); [wdc - was when] + (begin + (gnatural-for-each size + (lambda: ((t : Integer)) + (if (vector-ref from-m t) + (begin ; [wdc - was when] + (vector-set! from-f t #t) + #t) + #t))) + #t) + #t))))))) + res))) + + +;;; ==== test input ==== + +; Produces all directed graphs with N vertices, distinguished root, +; and out-degree bounded by 2, upto isomorphism (there are 44). + +;(define go +; (let ((N 7)) +; (fold-over-rdg N +; 2 +; cons +; '()))) + +(let ((input (with-input-from-file "input.txt" read))) + (time + (let: loop : (Listof RDG) + ((n : Integer 3) (v : (Listof RDG) '())) + (if (zero? n) + v + (loop (- n 1) + (fold-over-rdg (if input 6 0) + 2 + (ann cons (RDG (Listof RDG) -> (Listof RDG))) + (ann '() (Listof RDG)))))))) diff --git a/collects/tests/racket/benchmarks/common/puzzle-typed.rkt b/collects/tests/racket/benchmarks/common/puzzle-typed.rkt new file mode 100644 index 0000000000..76feb4f858 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/puzzle-typed.rkt @@ -0,0 +1,199 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; File: puzzle.sch +; Description: PUZZLE benchmark +; Author: Richard Gabriel, after Forrest Baskett +; Created: 12-Apr-85 +; Modified: 12-Apr-85 14:20:23 (Bob Shaw) +; 11-Aug-87 (Will Clinger) +; 22-Jan-88 (Will Clinger) +; Language: Scheme +; Status: Public Domain +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +#lang typed/scheme/base + +(: iota (Integer -> (Listof Integer))) +(define (iota n) + (do: : (Listof Integer) + ((n : Integer n (- n 1)) + (list : (Listof Integer) '() (cons (- n 1) list))) + ((zero? n) list))) + +;;; PUZZLE -- Forest Baskett's Puzzle benchmark, originally written in Pascal. + +(define size 1048575) +(define classmax 3) +(define typemax 12) + +(: *iii* Integer) +(define *iii* 0) +(: *kount* Integer) +(define *kount* 0) +(define *d* 8) + +(: *piececount* (Vectorof Integer)) +(define *piececount* (make-vector (+ classmax 1) 0)) +(: *class* (Vectorof Integer)) +(define *class* (make-vector (+ typemax 1) 0)) +(: *piecemax* (Vectorof Integer)) +(define *piecemax* (make-vector (+ typemax 1) 0)) +(: *puzzle* (Vectorof Boolean)) +(define *puzzle* (make-vector (+ size 1) #f)) +(: *p* (Vectorof (Vectorof Boolean))) +;; the references (vector #f) will be overwritten +;; but it's needed to appease the typechecker +(define *p* (make-vector (+ typemax 1) + (ann (vector #f) + (Vectorof Boolean)))) +(define nothing + (for-each (lambda: ((i : Integer)) + (vector-set! *p* i + (ann (make-vector (+ size 1) #f) + (Vectorof Boolean)))) + (iota (+ typemax 1)))) + +(: fit (Integer Integer -> Boolean)) +(define (fit i j) + (let ((end (vector-ref *piecemax* i))) + (do ((k 0 (+ k 1))) + ((or (> k end) + (and (vector-ref (vector-ref *p* i) k) + (vector-ref *puzzle* (+ j k)))) + (if (> k end) #t #f))))) + +(: place (Integer Integer -> Integer)) +(define (place i j) + (let ((end (vector-ref *piecemax* i))) + (do ((k 0 (+ k 1))) + ((> k end)) + (cond ((vector-ref (vector-ref *p* i) k) + (vector-set! *puzzle* (+ j k) #t) + #t))) + (vector-set! *piececount* + (vector-ref *class* i) + (- (vector-ref *piececount* (vector-ref *class* i)) 1)) + (do ((k j (+ k 1))) + ((or (> k size) (not (vector-ref *puzzle* k))) + ; (newline) + ; (display "*Puzzle* filled") + (if (> k size) 0 k))))) + +(: puzzle-remove (Integer Integer -> Void)) +(define (puzzle-remove i j) + (let ((end (vector-ref *piecemax* i))) + (do ((k 0 (+ k 1))) + ((> k end)) + (cond ((vector-ref (vector-ref *p* i) k) + (vector-set! *puzzle* (+ j k) #f) + #f))) + (vector-set! *piececount* + (vector-ref *class* i) + (+ (vector-ref *piececount* (vector-ref *class* i)) 1)))) + + +(: trial (Integer -> Boolean)) +(define (trial j) + (let: ((k : Integer 0)) + (call-with-current-continuation + (lambda: ((return : (Boolean -> Nothing))) + (do: : Boolean + ((i : Integer 0 (+ i 1))) + ((> i typemax) (set! *kount* (+ *kount* 1)) #f) + (cond + ((not + (zero? + (vector-ref *piececount* (vector-ref *class* i)))) + (cond + ((fit i j) + (set! k (place i j)) + (cond + ((or (trial k) (zero? k)) + ;(trial-output (+ i 1) (+ k 1)) + (set! *kount* (+ *kount* 1)) + (return #t)) + (else (puzzle-remove i j)))))))))))) + +(: trial-output (Integer Integer -> Void)) +(define (trial-output x y) + (newline) + (display (string-append "Piece " + (number->string x #;'(int)) + " at " + (number->string y #;'(int)) + "."))) + +(: definePiece (Integer Integer Integer Integer -> Void)) +(define (definePiece iclass ii jj kk) + (let: ((index : Integer 0)) + (do: : Null + ((i : Integer 0 (+ i 1))) + ((> i ii) '()) + (do: : Null + ((j : Integer 0 (+ j 1))) + ((> j jj) '()) + (do: : Null + ((k : Integer 0 (+ k 1))) + ((> k kk) '()) + (set! index (+ i (* *d* (+ j (* *d* k))))) + (vector-set! (vector-ref *p* *iii*) index #t)))) + (vector-set! *class* *iii* iclass) + (vector-set! *piecemax* *iii* index) + (cond ((not (= *iii* typemax)) + (set! *iii* (+ *iii* 1)))))) + +(: start ( -> Void)) +(define (start) + (do ((m 0 (+ m 1))) + ((> m size)) + (vector-set! *puzzle* m #t)) + (do ((i 1 (+ i 1))) + ((> i 5)) + (do ((j 1 (+ j 1))) + ((> j 5)) + (do ((k 1 (+ k 1))) + ((> k 5)) + (vector-set! *puzzle* (+ i (* *d* (+ j (* *d* k)))) #f)))) + (do ((i 0 (+ i 1))) + ((> i typemax)) + (do ((m 0 (+ m 1))) + ((> m size)) + (vector-set! (vector-ref *p* i) m #f))) + (set! *iii* 0) + (definePiece 0 3 1 0) + (definePiece 0 1 0 3) + (definePiece 0 0 3 1) + (definePiece 0 1 3 0) + (definePiece 0 3 0 1) + (definePiece 0 0 1 3) + + (definePiece 1 2 0 0) + (definePiece 1 0 2 0) + (definePiece 1 0 0 2) + + (definePiece 2 1 1 0) + (definePiece 2 1 0 1) + (definePiece 2 0 1 1) + + (definePiece 3 1 1 1) + + (vector-set! *piececount* 0 13) + (vector-set! *piececount* 1 3) + (vector-set! *piececount* 2 1) + (vector-set! *piececount* 3 1) + (let: ((m : Integer (+ (* *d* (+ *d* 1)) 1)) + (n : Integer 0)) + (cond ((fit 0 m) (set! n (place 0 m))) + (else (begin (newline) (display "Error.")))) + (cond ((trial n) + (begin (newline) + (display "Success in ") + (write *kount*) + (display " trials.") + (newline))) + (else (begin (newline) (display "Failure.")))))) + +;;; call: (start) + +(time (start)) + + diff --git a/collects/tests/racket/benchmarks/common/tak-typed.rkt b/collects/tests/racket/benchmarks/common/tak-typed.rkt new file mode 100644 index 0000000000..13ceb314de --- /dev/null +++ b/collects/tests/racket/benchmarks/common/tak-typed.rkt @@ -0,0 +1,32 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; File: tak.sch +; Description: TAK benchmark from the Gabriel tests +; Author: Richard Gabriel +; Created: 12-Apr-85 +; Modified: 12-Apr-85 09:58:18 (Bob Shaw) +; 22-Jul-87 (Will Clinger) +; 10-May-10 (Vincent St-Amour) +; Language: Typed Scheme +; Status: Public Domain +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; TAK -- A vanilla version of the TAKeuchi function + +#lang typed/scheme/base + +(: tak (Integer Integer Integer -> Integer)) +(define (tak x y z) + (if (not (< y x)) + z + (tak (tak (- x 1) y z) + (tak (- y 1) z x) + (tak (- z 1) x y)))) + +;;; call: (tak 18 12 6) + +(let ((input (with-input-from-file "input.txt" read))) + (time + (let: loop : Integer ((n : Integer 500) (v : Integer 0)) + (if (zero? n) + v + (loop (- n 1) (tak 18 12 (if input 6 0))))))) diff --git a/collects/tests/racket/benchmarks/common/takl-typed.rkt b/collects/tests/racket/benchmarks/common/takl-typed.rkt new file mode 100644 index 0000000000..1b26e969db --- /dev/null +++ b/collects/tests/racket/benchmarks/common/takl-typed.rkt @@ -0,0 +1,49 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; File: takl.sch +; Description: TAKL benchmark from the Gabriel tests +; Author: Richard Gabriel +; Created: 12-Apr-85 +; Modified: 12-Apr-85 10:07:00 (Bob Shaw) +; 22-Jul-87 (Will Clinger) +; 10-May-10 (Vincent St-Amour) +; Language: Typed Scheme +; Status: Public Domain +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; TAKL -- The TAKeuchi function using lists as counters. + +#lang typed/scheme/base + +(: listn (Integer -> (Listof Integer))) +(define (listn n) + (if (not (= 0 n)) + (cons n (listn (- n 1))) + '())) + +(define l18l (listn 18)) +(define l12l (listn 12)) +(define l6l (listn 2)) + +(: mas (All (X) ((Listof X) (Listof X) (Listof X) -> (Listof X)))) +(define (mas x y z) + (if (not (shorterp y x)) + z + (mas (mas (cdr x) + y z) + (mas (cdr y) + z x) + (mas (cdr z) + x y)))) + +(: shorterp (All (X) ((Listof X) (Listof X) -> Boolean))) +(define (shorterp x y) + (and (not (null? y)) + (or (null? x) + (shorterp (cdr x) + (cdr y))))) + +;;; call: (mas 18l 12l 6l) + + +(let ((v (if (with-input-from-file "input.txt" read) l6l '()))) + (time (mas l18l l12l v))) diff --git a/collects/tests/racket/benchmarks/common/takr-typed.rkt b/collects/tests/racket/benchmarks/common/takr-typed.rkt new file mode 100644 index 0000000000..fac26304c6 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/takr-typed.rkt @@ -0,0 +1,627 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; File: takr.sch +; Description: TAKR benchmark +; Author: Richard Gabriel +; Created: 12-Apr-85 +; Modified: 12-Apr-85 10:12:43 (Bob Shaw) +; 22-Jul-87 (Will Clinger) +; 10-May-10 (Vincent St-Amour) +; Language: Scheme +; Status: Public Domain +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; TAKR -- 100 function (count `em) version of TAK that tries to defeat cache +;;; memory effects. Results should be the same as for TAK on stack machines. +;;; Distribution of calls is not completely flat. + +#lang typed/scheme/base + +(: tak0 (Integer Integer Integer -> Integer)) +(define (tak0 x y z) + (cond ((not (< y x)) z) + (else (tak1 (tak37 (- x 1) y z) + (tak11 (- y 1) z x) + (tak17 (- z 1) x y))))) +(: tak1 (Integer Integer Integer -> Integer)) +(define (tak1 x y z) + (cond ((not (< y x)) z) + (else (tak2 (tak74 (- x 1) y z) + (tak22 (- y 1) z x) + (tak34 (- z 1) x y))))) +(: tak2 (Integer Integer Integer -> Integer)) +(define (tak2 x y z) + (cond ((not (< y x)) z) + (else (tak3 (tak11 (- x 1) y z) + (tak33 (- y 1) z x) + (tak51 (- z 1) x y))))) +(: tak3 (Integer Integer Integer -> Integer)) +(define (tak3 x y z) + (cond ((not (< y x)) z) + (else (tak4 (tak48 (- x 1) y z) + (tak44 (- y 1) z x) + (tak68 (- z 1) x y))))) +(: tak4 (Integer Integer Integer -> Integer)) +(define (tak4 x y z) + (cond ((not (< y x)) z) + (else (tak5 (tak85 (- x 1) y z) + (tak55 (- y 1) z x) + (tak85 (- z 1) x y))))) +(: tak5 (Integer Integer Integer -> Integer)) +(define (tak5 x y z) + (cond ((not (< y x)) z) + (else (tak6 (tak22 (- x 1) y z) + (tak66 (- y 1) z x) + (tak2 (- z 1) x y))))) +(: tak6 (Integer Integer Integer -> Integer)) +(define (tak6 x y z) + (cond ((not (< y x)) z) + (else (tak7 (tak59 (- x 1) y z) + (tak77 (- y 1) z x) + (tak19 (- z 1) x y))))) +(: tak7 (Integer Integer Integer -> Integer)) +(define (tak7 x y z) + (cond ((not (< y x)) z) + (else (tak8 (tak96 (- x 1) y z) + (tak88 (- y 1) z x) + (tak36 (- z 1) x y))))) +(: tak8 (Integer Integer Integer -> Integer)) +(define (tak8 x y z) + (cond ((not (< y x)) z) + (else (tak9 (tak33 (- x 1) y z) + (tak99 (- y 1) z x) + (tak53 (- z 1) x y))))) +(: tak9 (Integer Integer Integer -> Integer)) +(define (tak9 x y z) + (cond ((not (< y x)) z) + (else (tak10 (tak70 (- x 1) y z) + (tak10 (- y 1) z x) + (tak70 (- z 1) x y))))) +(: tak10 (Integer Integer Integer -> Integer)) +(define (tak10 x y z) + (cond ((not (< y x)) z) + (else (tak11 (tak7 (- x 1) y z) + (tak21 (- y 1) z x) + (tak87 (- z 1) x y))))) +(: tak11 (Integer Integer Integer -> Integer)) +(define (tak11 x y z) + (cond ((not (< y x)) z) + (else (tak12 (tak44 (- x 1) y z) + (tak32 (- y 1) z x) + (tak4 (- z 1) x y))))) +(: tak12 (Integer Integer Integer -> Integer)) +(define (tak12 x y z) + (cond ((not (< y x)) z) + (else (tak13 (tak81 (- x 1) y z) + (tak43 (- y 1) z x) + (tak21 (- z 1) x y))))) +(: tak13 (Integer Integer Integer -> Integer)) +(define (tak13 x y z) + (cond ((not (< y x)) z) + (else (tak14 (tak18 (- x 1) y z) + (tak54 (- y 1) z x) + (tak38 (- z 1) x y))))) +(: tak14 (Integer Integer Integer -> Integer)) +(define (tak14 x y z) + (cond ((not (< y x)) z) + (else (tak15 (tak55 (- x 1) y z) + (tak65 (- y 1) z x) + (tak55 (- z 1) x y))))) +(: tak15 (Integer Integer Integer -> Integer)) +(define (tak15 x y z) + (cond ((not (< y x)) z) + (else (tak16 (tak92 (- x 1) y z) + (tak76 (- y 1) z x) + (tak72 (- z 1) x y))))) +(: tak16 (Integer Integer Integer -> Integer)) +(define (tak16 x y z) + (cond ((not (< y x)) z) + (else (tak17 (tak29 (- x 1) y z) + (tak87 (- y 1) z x) + (tak89 (- z 1) x y))))) +(: tak17 (Integer Integer Integer -> Integer)) +(define (tak17 x y z) + (cond ((not (< y x)) z) + (else (tak18 (tak66 (- x 1) y z) + (tak98 (- y 1) z x) + (tak6 (- z 1) x y))))) +(: tak18 (Integer Integer Integer -> Integer)) +(define (tak18 x y z) + (cond ((not (< y x)) z) + (else (tak19 (tak3 (- x 1) y z) + (tak9 (- y 1) z x) + (tak23 (- z 1) x y))))) +(: tak19 (Integer Integer Integer -> Integer)) +(define (tak19 x y z) + (cond ((not (< y x)) z) + (else (tak20 (tak40 (- x 1) y z) + (tak20 (- y 1) z x) + (tak40 (- z 1) x y))))) +(: tak20 (Integer Integer Integer -> Integer)) +(define (tak20 x y z) + (cond ((not (< y x)) z) + (else (tak21 (tak77 (- x 1) y z) + (tak31 (- y 1) z x) + (tak57 (- z 1) x y))))) +(: tak21 (Integer Integer Integer -> Integer)) +(define (tak21 x y z) + (cond ((not (< y x)) z) + (else (tak22 (tak14 (- x 1) y z) + (tak42 (- y 1) z x) + (tak74 (- z 1) x y))))) +(: tak22 (Integer Integer Integer -> Integer)) +(define (tak22 x y z) + (cond ((not (< y x)) z) + (else (tak23 (tak51 (- x 1) y z) + (tak53 (- y 1) z x) + (tak91 (- z 1) x y))))) +(: tak23 (Integer Integer Integer -> Integer)) +(define (tak23 x y z) + (cond ((not (< y x)) z) + (else (tak24 (tak88 (- x 1) y z) + (tak64 (- y 1) z x) + (tak8 (- z 1) x y))))) +(: tak24 (Integer Integer Integer -> Integer)) +(define (tak24 x y z) + (cond ((not (< y x)) z) + (else (tak25 (tak25 (- x 1) y z) + (tak75 (- y 1) z x) + (tak25 (- z 1) x y))))) +(: tak25 (Integer Integer Integer -> Integer)) +(define (tak25 x y z) + (cond ((not (< y x)) z) + (else (tak26 (tak62 (- x 1) y z) + (tak86 (- y 1) z x) + (tak42 (- z 1) x y))))) +(: tak26 (Integer Integer Integer -> Integer)) +(define (tak26 x y z) + (cond ((not (< y x)) z) + (else (tak27 (tak99 (- x 1) y z) + (tak97 (- y 1) z x) + (tak59 (- z 1) x y))))) +(: tak27 (Integer Integer Integer -> Integer)) +(define (tak27 x y z) + (cond ((not (< y x)) z) + (else (tak28 (tak36 (- x 1) y z) + (tak8 (- y 1) z x) + (tak76 (- z 1) x y))))) +(: tak28 (Integer Integer Integer -> Integer)) +(define (tak28 x y z) + (cond ((not (< y x)) z) + (else (tak29 (tak73 (- x 1) y z) + (tak19 (- y 1) z x) + (tak93 (- z 1) x y))))) +(: tak29 (Integer Integer Integer -> Integer)) +(define (tak29 x y z) + (cond ((not (< y x)) z) + (else (tak30 (tak10 (- x 1) y z) + (tak30 (- y 1) z x) + (tak10 (- z 1) x y))))) +(: tak30 (Integer Integer Integer -> Integer)) +(define (tak30 x y z) + (cond ((not (< y x)) z) + (else (tak31 (tak47 (- x 1) y z) + (tak41 (- y 1) z x) + (tak27 (- z 1) x y))))) +(: tak31 (Integer Integer Integer -> Integer)) +(define (tak31 x y z) + (cond ((not (< y x)) z) + (else (tak32 (tak84 (- x 1) y z) + (tak52 (- y 1) z x) + (tak44 (- z 1) x y))))) +(: tak32 (Integer Integer Integer -> Integer)) +(define (tak32 x y z) + (cond ((not (< y x)) z) + (else (tak33 (tak21 (- x 1) y z) + (tak63 (- y 1) z x) + (tak61 (- z 1) x y))))) +(: tak33 (Integer Integer Integer -> Integer)) +(define (tak33 x y z) + (cond ((not (< y x)) z) + (else (tak34 (tak58 (- x 1) y z) + (tak74 (- y 1) z x) + (tak78 (- z 1) x y))))) +(: tak34 (Integer Integer Integer -> Integer)) +(define (tak34 x y z) + (cond ((not (< y x)) z) + (else (tak35 (tak95 (- x 1) y z) + (tak85 (- y 1) z x) + (tak95 (- z 1) x y))))) +(: tak35 (Integer Integer Integer -> Integer)) +(define (tak35 x y z) + (cond ((not (< y x)) z) + (else (tak36 (tak32 (- x 1) y z) + (tak96 (- y 1) z x) + (tak12 (- z 1) x y))))) +(: tak36 (Integer Integer Integer -> Integer)) +(define (tak36 x y z) + (cond ((not (< y x)) z) + (else (tak37 (tak69 (- x 1) y z) + (tak7 (- y 1) z x) + (tak29 (- z 1) x y))))) +(: tak37 (Integer Integer Integer -> Integer)) +(define (tak37 x y z) + (cond ((not (< y x)) z) + (else (tak38 (tak6 (- x 1) y z) + (tak18 (- y 1) z x) + (tak46 (- z 1) x y))))) +(: tak38 (Integer Integer Integer -> Integer)) +(define (tak38 x y z) + (cond ((not (< y x)) z) + (else (tak39 (tak43 (- x 1) y z) + (tak29 (- y 1) z x) + (tak63 (- z 1) x y))))) +(: tak39 (Integer Integer Integer -> Integer)) +(define (tak39 x y z) + (cond ((not (< y x)) z) + (else (tak40 (tak80 (- x 1) y z) + (tak40 (- y 1) z x) + (tak80 (- z 1) x y))))) +(: tak40 (Integer Integer Integer -> Integer)) +(define (tak40 x y z) + (cond ((not (< y x)) z) + (else (tak41 (tak17 (- x 1) y z) + (tak51 (- y 1) z x) + (tak97 (- z 1) x y))))) +(: tak41 (Integer Integer Integer -> Integer)) +(define (tak41 x y z) + (cond ((not (< y x)) z) + (else (tak42 (tak54 (- x 1) y z) + (tak62 (- y 1) z x) + (tak14 (- z 1) x y))))) +(: tak42 (Integer Integer Integer -> Integer)) +(define (tak42 x y z) + (cond ((not (< y x)) z) + (else (tak43 (tak91 (- x 1) y z) + (tak73 (- y 1) z x) + (tak31 (- z 1) x y))))) +(: tak43 (Integer Integer Integer -> Integer)) +(define (tak43 x y z) + (cond ((not (< y x)) z) + (else (tak44 (tak28 (- x 1) y z) + (tak84 (- y 1) z x) + (tak48 (- z 1) x y))))) +(: tak44 (Integer Integer Integer -> Integer)) +(define (tak44 x y z) + (cond ((not (< y x)) z) + (else (tak45 (tak65 (- x 1) y z) + (tak95 (- y 1) z x) + (tak65 (- z 1) x y))))) +(: tak45 (Integer Integer Integer -> Integer)) +(define (tak45 x y z) + (cond ((not (< y x)) z) + (else (tak46 (tak2 (- x 1) y z) + (tak6 (- y 1) z x) + (tak82 (- z 1) x y))))) +(: tak46 (Integer Integer Integer -> Integer)) +(define (tak46 x y z) + (cond ((not (< y x)) z) + (else (tak47 (tak39 (- x 1) y z) + (tak17 (- y 1) z x) + (tak99 (- z 1) x y))))) +(: tak47 (Integer Integer Integer -> Integer)) +(define (tak47 x y z) + (cond ((not (< y x)) z) + (else (tak48 (tak76 (- x 1) y z) + (tak28 (- y 1) z x) + (tak16 (- z 1) x y))))) +(: tak48 (Integer Integer Integer -> Integer)) +(define (tak48 x y z) + (cond ((not (< y x)) z) + (else (tak49 (tak13 (- x 1) y z) + (tak39 (- y 1) z x) + (tak33 (- z 1) x y))))) +(: tak49 (Integer Integer Integer -> Integer)) +(define (tak49 x y z) + (cond ((not (< y x)) z) + (else (tak50 (tak50 (- x 1) y z) + (tak50 (- y 1) z x) + (tak50 (- z 1) x y))))) +(: tak50 (Integer Integer Integer -> Integer)) +(define (tak50 x y z) + (cond ((not (< y x)) z) + (else (tak51 (tak87 (- x 1) y z) + (tak61 (- y 1) z x) + (tak67 (- z 1) x y))))) +(: tak51 (Integer Integer Integer -> Integer)) +(define (tak51 x y z) + (cond ((not (< y x)) z) + (else (tak52 (tak24 (- x 1) y z) + (tak72 (- y 1) z x) + (tak84 (- z 1) x y))))) +(: tak52 (Integer Integer Integer -> Integer)) +(define (tak52 x y z) + (cond ((not (< y x)) z) + (else (tak53 (tak61 (- x 1) y z) + (tak83 (- y 1) z x) + (tak1 (- z 1) x y))))) +(: tak53 (Integer Integer Integer -> Integer)) +(define (tak53 x y z) + (cond ((not (< y x)) z) + (else (tak54 (tak98 (- x 1) y z) + (tak94 (- y 1) z x) + (tak18 (- z 1) x y))))) +(: tak54 (Integer Integer Integer -> Integer)) +(define (tak54 x y z) + (cond ((not (< y x)) z) + (else (tak55 (tak35 (- x 1) y z) + (tak5 (- y 1) z x) + (tak35 (- z 1) x y))))) +(: tak55 (Integer Integer Integer -> Integer)) +(define (tak55 x y z) + (cond ((not (< y x)) z) + (else (tak56 (tak72 (- x 1) y z) + (tak16 (- y 1) z x) + (tak52 (- z 1) x y))))) +(: tak56 (Integer Integer Integer -> Integer)) +(define (tak56 x y z) + (cond ((not (< y x)) z) + (else (tak57 (tak9 (- x 1) y z) + (tak27 (- y 1) z x) + (tak69 (- z 1) x y))))) +(: tak57 (Integer Integer Integer -> Integer)) +(define (tak57 x y z) + (cond ((not (< y x)) z) + (else (tak58 (tak46 (- x 1) y z) + (tak38 (- y 1) z x) + (tak86 (- z 1) x y))))) +(: tak58 (Integer Integer Integer -> Integer)) +(define (tak58 x y z) + (cond ((not (< y x)) z) + (else (tak59 (tak83 (- x 1) y z) + (tak49 (- y 1) z x) + (tak3 (- z 1) x y))))) +(: tak59 (Integer Integer Integer -> Integer)) +(define (tak59 x y z) + (cond ((not (< y x)) z) + (else (tak60 (tak20 (- x 1) y z) + (tak60 (- y 1) z x) + (tak20 (- z 1) x y))))) +(: tak60 (Integer Integer Integer -> Integer)) +(define (tak60 x y z) + (cond ((not (< y x)) z) + (else (tak61 (tak57 (- x 1) y z) + (tak71 (- y 1) z x) + (tak37 (- z 1) x y))))) +(: tak61 (Integer Integer Integer -> Integer)) +(define (tak61 x y z) + (cond ((not (< y x)) z) + (else (tak62 (tak94 (- x 1) y z) + (tak82 (- y 1) z x) + (tak54 (- z 1) x y))))) +(: tak62 (Integer Integer Integer -> Integer)) +(define (tak62 x y z) + (cond ((not (< y x)) z) + (else (tak63 (tak31 (- x 1) y z) + (tak93 (- y 1) z x) + (tak71 (- z 1) x y))))) +(: tak63 (Integer Integer Integer -> Integer)) +(define (tak63 x y z) + (cond ((not (< y x)) z) + (else (tak64 (tak68 (- x 1) y z) + (tak4 (- y 1) z x) + (tak88 (- z 1) x y))))) +(: tak64 (Integer Integer Integer -> Integer)) +(define (tak64 x y z) + (cond ((not (< y x)) z) + (else (tak65 (tak5 (- x 1) y z) + (tak15 (- y 1) z x) + (tak5 (- z 1) x y))))) +(: tak65 (Integer Integer Integer -> Integer)) +(define (tak65 x y z) + (cond ((not (< y x)) z) + (else (tak66 (tak42 (- x 1) y z) + (tak26 (- y 1) z x) + (tak22 (- z 1) x y))))) +(: tak66 (Integer Integer Integer -> Integer)) +(define (tak66 x y z) + (cond ((not (< y x)) z) + (else (tak67 (tak79 (- x 1) y z) + (tak37 (- y 1) z x) + (tak39 (- z 1) x y))))) +(: tak67 (Integer Integer Integer -> Integer)) +(define (tak67 x y z) + (cond ((not (< y x)) z) + (else (tak68 (tak16 (- x 1) y z) + (tak48 (- y 1) z x) + (tak56 (- z 1) x y))))) +(: tak68 (Integer Integer Integer -> Integer)) +(define (tak68 x y z) + (cond ((not (< y x)) z) + (else (tak69 (tak53 (- x 1) y z) + (tak59 (- y 1) z x) + (tak73 (- z 1) x y))))) +(: tak69 (Integer Integer Integer -> Integer)) +(define (tak69 x y z) + (cond ((not (< y x)) z) + (else (tak70 (tak90 (- x 1) y z) + (tak70 (- y 1) z x) + (tak90 (- z 1) x y))))) +(: tak70 (Integer Integer Integer -> Integer)) +(define (tak70 x y z) + (cond ((not (< y x)) z) + (else (tak71 (tak27 (- x 1) y z) + (tak81 (- y 1) z x) + (tak7 (- z 1) x y))))) +(: tak71 (Integer Integer Integer -> Integer)) +(define (tak71 x y z) + (cond ((not (< y x)) z) + (else (tak72 (tak64 (- x 1) y z) + (tak92 (- y 1) z x) + (tak24 (- z 1) x y))))) +(: tak72 (Integer Integer Integer -> Integer)) +(define (tak72 x y z) + (cond ((not (< y x)) z) + (else (tak73 (tak1 (- x 1) y z) + (tak3 (- y 1) z x) + (tak41 (- z 1) x y))))) +(: tak73 (Integer Integer Integer -> Integer)) +(define (tak73 x y z) + (cond ((not (< y x)) z) + (else (tak74 (tak38 (- x 1) y z) + (tak14 (- y 1) z x) + (tak58 (- z 1) x y))))) +(: tak74 (Integer Integer Integer -> Integer)) +(define (tak74 x y z) + (cond ((not (< y x)) z) + (else (tak75 (tak75 (- x 1) y z) + (tak25 (- y 1) z x) + (tak75 (- z 1) x y))))) +(: tak75 (Integer Integer Integer -> Integer)) +(define (tak75 x y z) + (cond ((not (< y x)) z) + (else (tak76 (tak12 (- x 1) y z) + (tak36 (- y 1) z x) + (tak92 (- z 1) x y))))) +(: tak76 (Integer Integer Integer -> Integer)) +(define (tak76 x y z) + (cond ((not (< y x)) z) + (else (tak77 (tak49 (- x 1) y z) + (tak47 (- y 1) z x) + (tak9 (- z 1) x y))))) +(: tak77 (Integer Integer Integer -> Integer)) +(define (tak77 x y z) + (cond ((not (< y x)) z) + (else (tak78 (tak86 (- x 1) y z) + (tak58 (- y 1) z x) + (tak26 (- z 1) x y))))) +(: tak78 (Integer Integer Integer -> Integer)) +(define (tak78 x y z) + (cond ((not (< y x)) z) + (else (tak79 (tak23 (- x 1) y z) + (tak69 (- y 1) z x) + (tak43 (- z 1) x y))))) +(: tak79 (Integer Integer Integer -> Integer)) +(define (tak79 x y z) + (cond ((not (< y x)) z) + (else (tak80 (tak60 (- x 1) y z) + (tak80 (- y 1) z x) + (tak60 (- z 1) x y))))) +(: tak80 (Integer Integer Integer -> Integer)) +(define (tak80 x y z) + (cond ((not (< y x)) z) + (else (tak81 (tak97 (- x 1) y z) + (tak91 (- y 1) z x) + (tak77 (- z 1) x y))))) +(: tak81 (Integer Integer Integer -> Integer)) +(define (tak81 x y z) + (cond ((not (< y x)) z) + (else (tak82 (tak34 (- x 1) y z) + (tak2 (- y 1) z x) + (tak94 (- z 1) x y))))) +(: tak82 (Integer Integer Integer -> Integer)) +(define (tak82 x y z) + (cond ((not (< y x)) z) + (else (tak83 (tak71 (- x 1) y z) + (tak13 (- y 1) z x) + (tak11 (- z 1) x y))))) +(: tak83 (Integer Integer Integer -> Integer)) +(define (tak83 x y z) + (cond ((not (< y x)) z) + (else (tak84 (tak8 (- x 1) y z) + (tak24 (- y 1) z x) + (tak28 (- z 1) x y))))) +(: tak84 (Integer Integer Integer -> Integer)) +(define (tak84 x y z) + (cond ((not (< y x)) z) + (else (tak85 (tak45 (- x 1) y z) + (tak35 (- y 1) z x) + (tak45 (- z 1) x y))))) +(: tak85 (Integer Integer Integer -> Integer)) +(define (tak85 x y z) + (cond ((not (< y x)) z) + (else (tak86 (tak82 (- x 1) y z) + (tak46 (- y 1) z x) + (tak62 (- z 1) x y))))) +(: tak86 (Integer Integer Integer -> Integer)) +(define (tak86 x y z) + (cond ((not (< y x)) z) + (else (tak87 (tak19 (- x 1) y z) + (tak57 (- y 1) z x) + (tak79 (- z 1) x y))))) +(: tak87 (Integer Integer Integer -> Integer)) +(define (tak87 x y z) + (cond ((not (< y x)) z) + (else (tak88 (tak56 (- x 1) y z) + (tak68 (- y 1) z x) + (tak96 (- z 1) x y))))) +(: tak88 (Integer Integer Integer -> Integer)) +(define (tak88 x y z) + (cond ((not (< y x)) z) + (else (tak89 (tak93 (- x 1) y z) + (tak79 (- y 1) z x) + (tak13 (- z 1) x y))))) +(: tak89 (Integer Integer Integer -> Integer)) +(define (tak89 x y z) + (cond ((not (< y x)) z) + (else (tak90 (tak30 (- x 1) y z) + (tak90 (- y 1) z x) + (tak30 (- z 1) x y))))) +(: tak90 (Integer Integer Integer -> Integer)) +(define (tak90 x y z) + (cond ((not (< y x)) z) + (else (tak91 (tak67 (- x 1) y z) + (tak1 (- y 1) z x) + (tak47 (- z 1) x y))))) +(: tak91 (Integer Integer Integer -> Integer)) +(define (tak91 x y z) + (cond ((not (< y x)) z) + (else (tak92 (tak4 (- x 1) y z) + (tak12 (- y 1) z x) + (tak64 (- z 1) x y))))) +(: tak92 (Integer Integer Integer -> Integer)) +(define (tak92 x y z) + (cond ((not (< y x)) z) + (else (tak93 (tak41 (- x 1) y z) + (tak23 (- y 1) z x) + (tak81 (- z 1) x y))))) +(: tak93 (Integer Integer Integer -> Integer)) +(define (tak93 x y z) + (cond ((not (< y x)) z) + (else (tak94 (tak78 (- x 1) y z) + (tak34 (- y 1) z x) + (tak98 (- z 1) x y))))) +(: tak94 (Integer Integer Integer -> Integer)) +(define (tak94 x y z) + (cond ((not (< y x)) z) + (else (tak95 (tak15 (- x 1) y z) + (tak45 (- y 1) z x) + (tak15 (- z 1) x y))))) +(: tak95 (Integer Integer Integer -> Integer)) +(define (tak95 x y z) + (cond ((not (< y x)) z) + (else (tak96 (tak52 (- x 1) y z) + (tak56 (- y 1) z x) + (tak32 (- z 1) x y))))) +(: tak96 (Integer Integer Integer -> Integer)) +(define (tak96 x y z) + (cond ((not (< y x)) z) + (else (tak97 (tak89 (- x 1) y z) + (tak67 (- y 1) z x) + (tak49 (- z 1) x y))))) +(: tak97 (Integer Integer Integer -> Integer)) +(define (tak97 x y z) + (cond ((not (< y x)) z) + (else (tak98 (tak26 (- x 1) y z) + (tak78 (- y 1) z x) + (tak66 (- z 1) x y))))) +(: tak98 (Integer Integer Integer -> Integer)) +(define (tak98 x y z) + (cond ((not (< y x)) z) + (else (tak99 (tak63 (- x 1) y z) + (tak89 (- y 1) z x) + (tak83 (- z 1) x y))))) +(: tak99 (Integer Integer Integer -> Integer)) +(define (tak99 x y z) + (cond ((not (< y x)) z) + (else (tak0 (tak0 (- x 1) y z) + (tak0 (- y 1) z x) + (tak0 (- z 1) x y))))) + +;;; call: (tak0 18 12 6) + +(let ((input (with-input-from-file "input.txt" read))) + (time + (let: loop : Integer ((n : Integer 500) (v : Integer 0)) + (if (zero? n) + v + (loop (- n 1) (tak0 18 12 (if input 6 0))))))) diff --git a/collects/tests/racket/benchmarks/common/takr2-typed.rkt b/collects/tests/racket/benchmarks/common/takr2-typed.rkt new file mode 100644 index 0000000000..19ec9a915f --- /dev/null +++ b/collects/tests/racket/benchmarks/common/takr2-typed.rkt @@ -0,0 +1,631 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; File: takr.sch +; Description: TAKR benchmark +; Author: Richard Gabriel +; Created: 12-Apr-85 +; Modified: 12-Apr-85 10:12:43 (Bob Shaw) +; 22-Jul-87 (Will Clinger) +; 10-May-10 (Vincent St-Amour) +; Language: Typed Scheme +; Status: Public Domain +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; TAKR -- 100 function (count `em) version of TAK that tries to defeat cache +;;; memory effects. Results should be the same as for TAK on stack machines. +;;; Distribution of calls is not completely flat. + +#lang typed/scheme/base + +(: tak (Integer Integer Integer -> Integer)) +(define (tak x y z) + (: tak0 (Integer Integer Integer -> Integer)) + (define (tak0 x y z) + (cond ((not (< y x)) z) + (else (tak1 (tak37 (- x 1) y z) + (tak11 (- y 1) z x) + (tak17 (- z 1) x y))))) + (: tak1 (Integer Integer Integer -> Integer)) + (define (tak1 x y z) + (cond ((not (< y x)) z) + (else (tak2 (tak74 (- x 1) y z) + (tak22 (- y 1) z x) + (tak34 (- z 1) x y))))) + (: tak2 (Integer Integer Integer -> Integer)) + (define (tak2 x y z) + (cond ((not (< y x)) z) + (else (tak3 (tak11 (- x 1) y z) + (tak33 (- y 1) z x) + (tak51 (- z 1) x y))))) + (: tak3 (Integer Integer Integer -> Integer)) + (define (tak3 x y z) + (cond ((not (< y x)) z) + (else (tak4 (tak48 (- x 1) y z) + (tak44 (- y 1) z x) + (tak68 (- z 1) x y))))) + (: tak4 (Integer Integer Integer -> Integer)) + (define (tak4 x y z) + (cond ((not (< y x)) z) + (else (tak5 (tak85 (- x 1) y z) + (tak55 (- y 1) z x) + (tak85 (- z 1) x y))))) + (: tak5 (Integer Integer Integer -> Integer)) + (define (tak5 x y z) + (cond ((not (< y x)) z) + (else (tak6 (tak22 (- x 1) y z) + (tak66 (- y 1) z x) + (tak2 (- z 1) x y))))) + (: tak6 (Integer Integer Integer -> Integer)) + (define (tak6 x y z) + (cond ((not (< y x)) z) + (else (tak7 (tak59 (- x 1) y z) + (tak77 (- y 1) z x) + (tak19 (- z 1) x y))))) + (: tak7 (Integer Integer Integer -> Integer)) + (define (tak7 x y z) + (cond ((not (< y x)) z) + (else (tak8 (tak96 (- x 1) y z) + (tak88 (- y 1) z x) + (tak36 (- z 1) x y))))) + (: tak8 (Integer Integer Integer -> Integer)) + (define (tak8 x y z) + (cond ((not (< y x)) z) + (else (tak9 (tak33 (- x 1) y z) + (tak99 (- y 1) z x) + (tak53 (- z 1) x y))))) + (: tak9 (Integer Integer Integer -> Integer)) + (define (tak9 x y z) + (cond ((not (< y x)) z) + (else (tak10 (tak70 (- x 1) y z) + (tak10 (- y 1) z x) + (tak70 (- z 1) x y))))) + (: tak10 (Integer Integer Integer -> Integer)) + (define (tak10 x y z) + (cond ((not (< y x)) z) + (else (tak11 (tak7 (- x 1) y z) + (tak21 (- y 1) z x) + (tak87 (- z 1) x y))))) + (: tak11 (Integer Integer Integer -> Integer)) + (define (tak11 x y z) + (cond ((not (< y x)) z) + (else (tak12 (tak44 (- x 1) y z) + (tak32 (- y 1) z x) + (tak4 (- z 1) x y))))) + (: tak12 (Integer Integer Integer -> Integer)) + (define (tak12 x y z) + (cond ((not (< y x)) z) + (else (tak13 (tak81 (- x 1) y z) + (tak43 (- y 1) z x) + (tak21 (- z 1) x y))))) + (: tak13 (Integer Integer Integer -> Integer)) + (define (tak13 x y z) + (cond ((not (< y x)) z) + (else (tak14 (tak18 (- x 1) y z) + (tak54 (- y 1) z x) + (tak38 (- z 1) x y))))) + (: tak14 (Integer Integer Integer -> Integer)) + (define (tak14 x y z) + (cond ((not (< y x)) z) + (else (tak15 (tak55 (- x 1) y z) + (tak65 (- y 1) z x) + (tak55 (- z 1) x y))))) + (: tak15 (Integer Integer Integer -> Integer)) + (define (tak15 x y z) + (cond ((not (< y x)) z) + (else (tak16 (tak92 (- x 1) y z) + (tak76 (- y 1) z x) + (tak72 (- z 1) x y))))) + (: tak16 (Integer Integer Integer -> Integer)) + (define (tak16 x y z) + (cond ((not (< y x)) z) + (else (tak17 (tak29 (- x 1) y z) + (tak87 (- y 1) z x) + (tak89 (- z 1) x y))))) + (: tak17 (Integer Integer Integer -> Integer)) + (define (tak17 x y z) + (cond ((not (< y x)) z) + (else (tak18 (tak66 (- x 1) y z) + (tak98 (- y 1) z x) + (tak6 (- z 1) x y))))) + (: tak18 (Integer Integer Integer -> Integer)) + (define (tak18 x y z) + (cond ((not (< y x)) z) + (else (tak19 (tak3 (- x 1) y z) + (tak9 (- y 1) z x) + (tak23 (- z 1) x y))))) + (: tak19 (Integer Integer Integer -> Integer)) + (define (tak19 x y z) + (cond ((not (< y x)) z) + (else (tak20 (tak40 (- x 1) y z) + (tak20 (- y 1) z x) + (tak40 (- z 1) x y))))) + (: tak20 (Integer Integer Integer -> Integer)) + (define (tak20 x y z) + (cond ((not (< y x)) z) + (else (tak21 (tak77 (- x 1) y z) + (tak31 (- y 1) z x) + (tak57 (- z 1) x y))))) + (: tak21 (Integer Integer Integer -> Integer)) + (define (tak21 x y z) + (cond ((not (< y x)) z) + (else (tak22 (tak14 (- x 1) y z) + (tak42 (- y 1) z x) + (tak74 (- z 1) x y))))) + (: tak22 (Integer Integer Integer -> Integer)) + (define (tak22 x y z) + (cond ((not (< y x)) z) + (else (tak23 (tak51 (- x 1) y z) + (tak53 (- y 1) z x) + (tak91 (- z 1) x y))))) + (: tak23 (Integer Integer Integer -> Integer)) + (define (tak23 x y z) + (cond ((not (< y x)) z) + (else (tak24 (tak88 (- x 1) y z) + (tak64 (- y 1) z x) + (tak8 (- z 1) x y))))) + (: tak24 (Integer Integer Integer -> Integer)) + (define (tak24 x y z) + (cond ((not (< y x)) z) + (else (tak25 (tak25 (- x 1) y z) + (tak75 (- y 1) z x) + (tak25 (- z 1) x y))))) + (: tak25 (Integer Integer Integer -> Integer)) + (define (tak25 x y z) + (cond ((not (< y x)) z) + (else (tak26 (tak62 (- x 1) y z) + (tak86 (- y 1) z x) + (tak42 (- z 1) x y))))) + (: tak26 (Integer Integer Integer -> Integer)) + (define (tak26 x y z) + (cond ((not (< y x)) z) + (else (tak27 (tak99 (- x 1) y z) + (tak97 (- y 1) z x) + (tak59 (- z 1) x y))))) + (: tak27 (Integer Integer Integer -> Integer)) + (define (tak27 x y z) + (cond ((not (< y x)) z) + (else (tak28 (tak36 (- x 1) y z) + (tak8 (- y 1) z x) + (tak76 (- z 1) x y))))) + (: tak28 (Integer Integer Integer -> Integer)) + (define (tak28 x y z) + (cond ((not (< y x)) z) + (else (tak29 (tak73 (- x 1) y z) + (tak19 (- y 1) z x) + (tak93 (- z 1) x y))))) + (: tak29 (Integer Integer Integer -> Integer)) + (define (tak29 x y z) + (cond ((not (< y x)) z) + (else (tak30 (tak10 (- x 1) y z) + (tak30 (- y 1) z x) + (tak10 (- z 1) x y))))) + (: tak30 (Integer Integer Integer -> Integer)) + (define (tak30 x y z) + (cond ((not (< y x)) z) + (else (tak31 (tak47 (- x 1) y z) + (tak41 (- y 1) z x) + (tak27 (- z 1) x y))))) + (: tak31 (Integer Integer Integer -> Integer)) + (define (tak31 x y z) + (cond ((not (< y x)) z) + (else (tak32 (tak84 (- x 1) y z) + (tak52 (- y 1) z x) + (tak44 (- z 1) x y))))) + (: tak32 (Integer Integer Integer -> Integer)) + (define (tak32 x y z) + (cond ((not (< y x)) z) + (else (tak33 (tak21 (- x 1) y z) + (tak63 (- y 1) z x) + (tak61 (- z 1) x y))))) + (: tak33 (Integer Integer Integer -> Integer)) + (define (tak33 x y z) + (cond ((not (< y x)) z) + (else (tak34 (tak58 (- x 1) y z) + (tak74 (- y 1) z x) + (tak78 (- z 1) x y))))) + (: tak34 (Integer Integer Integer -> Integer)) + (define (tak34 x y z) + (cond ((not (< y x)) z) + (else (tak35 (tak95 (- x 1) y z) + (tak85 (- y 1) z x) + (tak95 (- z 1) x y))))) + (: tak35 (Integer Integer Integer -> Integer)) + (define (tak35 x y z) + (cond ((not (< y x)) z) + (else (tak36 (tak32 (- x 1) y z) + (tak96 (- y 1) z x) + (tak12 (- z 1) x y))))) + (: tak36 (Integer Integer Integer -> Integer)) + (define (tak36 x y z) + (cond ((not (< y x)) z) + (else (tak37 (tak69 (- x 1) y z) + (tak7 (- y 1) z x) + (tak29 (- z 1) x y))))) + (: tak37 (Integer Integer Integer -> Integer)) + (define (tak37 x y z) + (cond ((not (< y x)) z) + (else (tak38 (tak6 (- x 1) y z) + (tak18 (- y 1) z x) + (tak46 (- z 1) x y))))) + (: tak38 (Integer Integer Integer -> Integer)) + (define (tak38 x y z) + (cond ((not (< y x)) z) + (else (tak39 (tak43 (- x 1) y z) + (tak29 (- y 1) z x) + (tak63 (- z 1) x y))))) + (: tak39 (Integer Integer Integer -> Integer)) + (define (tak39 x y z) + (cond ((not (< y x)) z) + (else (tak40 (tak80 (- x 1) y z) + (tak40 (- y 1) z x) + (tak80 (- z 1) x y))))) + (: tak40 (Integer Integer Integer -> Integer)) + (define (tak40 x y z) + (cond ((not (< y x)) z) + (else (tak41 (tak17 (- x 1) y z) + (tak51 (- y 1) z x) + (tak97 (- z 1) x y))))) + (: tak41 (Integer Integer Integer -> Integer)) + (define (tak41 x y z) + (cond ((not (< y x)) z) + (else (tak42 (tak54 (- x 1) y z) + (tak62 (- y 1) z x) + (tak14 (- z 1) x y))))) + (: tak42 (Integer Integer Integer -> Integer)) + (define (tak42 x y z) + (cond ((not (< y x)) z) + (else (tak43 (tak91 (- x 1) y z) + (tak73 (- y 1) z x) + (tak31 (- z 1) x y))))) + (: tak43 (Integer Integer Integer -> Integer)) + (define (tak43 x y z) + (cond ((not (< y x)) z) + (else (tak44 (tak28 (- x 1) y z) + (tak84 (- y 1) z x) + (tak48 (- z 1) x y))))) + (: tak44 (Integer Integer Integer -> Integer)) + (define (tak44 x y z) + (cond ((not (< y x)) z) + (else (tak45 (tak65 (- x 1) y z) + (tak95 (- y 1) z x) + (tak65 (- z 1) x y))))) + (: tak45 (Integer Integer Integer -> Integer)) + (define (tak45 x y z) + (cond ((not (< y x)) z) + (else (tak46 (tak2 (- x 1) y z) + (tak6 (- y 1) z x) + (tak82 (- z 1) x y))))) + (: tak46 (Integer Integer Integer -> Integer)) + (define (tak46 x y z) + (cond ((not (< y x)) z) + (else (tak47 (tak39 (- x 1) y z) + (tak17 (- y 1) z x) + (tak99 (- z 1) x y))))) + (: tak47 (Integer Integer Integer -> Integer)) + (define (tak47 x y z) + (cond ((not (< y x)) z) + (else (tak48 (tak76 (- x 1) y z) + (tak28 (- y 1) z x) + (tak16 (- z 1) x y))))) + (: tak48 (Integer Integer Integer -> Integer)) + (define (tak48 x y z) + (cond ((not (< y x)) z) + (else (tak49 (tak13 (- x 1) y z) + (tak39 (- y 1) z x) + (tak33 (- z 1) x y))))) + (: tak49 (Integer Integer Integer -> Integer)) + (define (tak49 x y z) + (cond ((not (< y x)) z) + (else (tak50 (tak50 (- x 1) y z) + (tak50 (- y 1) z x) + (tak50 (- z 1) x y))))) + (: tak50 (Integer Integer Integer -> Integer)) + (define (tak50 x y z) + (cond ((not (< y x)) z) + (else (tak51 (tak87 (- x 1) y z) + (tak61 (- y 1) z x) + (tak67 (- z 1) x y))))) + (: tak51 (Integer Integer Integer -> Integer)) + (define (tak51 x y z) + (cond ((not (< y x)) z) + (else (tak52 (tak24 (- x 1) y z) + (tak72 (- y 1) z x) + (tak84 (- z 1) x y))))) + (: tak52 (Integer Integer Integer -> Integer)) + (define (tak52 x y z) + (cond ((not (< y x)) z) + (else (tak53 (tak61 (- x 1) y z) + (tak83 (- y 1) z x) + (tak1 (- z 1) x y))))) + (: tak53 (Integer Integer Integer -> Integer)) + (define (tak53 x y z) + (cond ((not (< y x)) z) + (else (tak54 (tak98 (- x 1) y z) + (tak94 (- y 1) z x) + (tak18 (- z 1) x y))))) + (: tak54 (Integer Integer Integer -> Integer)) + (define (tak54 x y z) + (cond ((not (< y x)) z) + (else (tak55 (tak35 (- x 1) y z) + (tak5 (- y 1) z x) + (tak35 (- z 1) x y))))) + (: tak55 (Integer Integer Integer -> Integer)) + (define (tak55 x y z) + (cond ((not (< y x)) z) + (else (tak56 (tak72 (- x 1) y z) + (tak16 (- y 1) z x) + (tak52 (- z 1) x y))))) + (: tak56 (Integer Integer Integer -> Integer)) + (define (tak56 x y z) + (cond ((not (< y x)) z) + (else (tak57 (tak9 (- x 1) y z) + (tak27 (- y 1) z x) + (tak69 (- z 1) x y))))) + (: tak57 (Integer Integer Integer -> Integer)) + (define (tak57 x y z) + (cond ((not (< y x)) z) + (else (tak58 (tak46 (- x 1) y z) + (tak38 (- y 1) z x) + (tak86 (- z 1) x y))))) + (: tak58 (Integer Integer Integer -> Integer)) + (define (tak58 x y z) + (cond ((not (< y x)) z) + (else (tak59 (tak83 (- x 1) y z) + (tak49 (- y 1) z x) + (tak3 (- z 1) x y))))) + (: tak59 (Integer Integer Integer -> Integer)) + (define (tak59 x y z) + (cond ((not (< y x)) z) + (else (tak60 (tak20 (- x 1) y z) + (tak60 (- y 1) z x) + (tak20 (- z 1) x y))))) + (: tak60 (Integer Integer Integer -> Integer)) + (define (tak60 x y z) + (cond ((not (< y x)) z) + (else (tak61 (tak57 (- x 1) y z) + (tak71 (- y 1) z x) + (tak37 (- z 1) x y))))) + (: tak61 (Integer Integer Integer -> Integer)) + (define (tak61 x y z) + (cond ((not (< y x)) z) + (else (tak62 (tak94 (- x 1) y z) + (tak82 (- y 1) z x) + (tak54 (- z 1) x y))))) + (: tak62 (Integer Integer Integer -> Integer)) + (define (tak62 x y z) + (cond ((not (< y x)) z) + (else (tak63 (tak31 (- x 1) y z) + (tak93 (- y 1) z x) + (tak71 (- z 1) x y))))) + (: tak63 (Integer Integer Integer -> Integer)) + (define (tak63 x y z) + (cond ((not (< y x)) z) + (else (tak64 (tak68 (- x 1) y z) + (tak4 (- y 1) z x) + (tak88 (- z 1) x y))))) + (: tak64 (Integer Integer Integer -> Integer)) + (define (tak64 x y z) + (cond ((not (< y x)) z) + (else (tak65 (tak5 (- x 1) y z) + (tak15 (- y 1) z x) + (tak5 (- z 1) x y))))) + (: tak65 (Integer Integer Integer -> Integer)) + (define (tak65 x y z) + (cond ((not (< y x)) z) + (else (tak66 (tak42 (- x 1) y z) + (tak26 (- y 1) z x) + (tak22 (- z 1) x y))))) + (: tak66 (Integer Integer Integer -> Integer)) + (define (tak66 x y z) + (cond ((not (< y x)) z) + (else (tak67 (tak79 (- x 1) y z) + (tak37 (- y 1) z x) + (tak39 (- z 1) x y))))) + (: tak67 (Integer Integer Integer -> Integer)) + (define (tak67 x y z) + (cond ((not (< y x)) z) + (else (tak68 (tak16 (- x 1) y z) + (tak48 (- y 1) z x) + (tak56 (- z 1) x y))))) + (: tak68 (Integer Integer Integer -> Integer)) + (define (tak68 x y z) + (cond ((not (< y x)) z) + (else (tak69 (tak53 (- x 1) y z) + (tak59 (- y 1) z x) + (tak73 (- z 1) x y))))) + (: tak69 (Integer Integer Integer -> Integer)) + (define (tak69 x y z) + (cond ((not (< y x)) z) + (else (tak70 (tak90 (- x 1) y z) + (tak70 (- y 1) z x) + (tak90 (- z 1) x y))))) + (: tak70 (Integer Integer Integer -> Integer)) + (define (tak70 x y z) + (cond ((not (< y x)) z) + (else (tak71 (tak27 (- x 1) y z) + (tak81 (- y 1) z x) + (tak7 (- z 1) x y))))) + (: tak71 (Integer Integer Integer -> Integer)) + (define (tak71 x y z) + (cond ((not (< y x)) z) + (else (tak72 (tak64 (- x 1) y z) + (tak92 (- y 1) z x) + (tak24 (- z 1) x y))))) + (: tak72 (Integer Integer Integer -> Integer)) + (define (tak72 x y z) + (cond ((not (< y x)) z) + (else (tak73 (tak1 (- x 1) y z) + (tak3 (- y 1) z x) + (tak41 (- z 1) x y))))) + (: tak73 (Integer Integer Integer -> Integer)) + (define (tak73 x y z) + (cond ((not (< y x)) z) + (else (tak74 (tak38 (- x 1) y z) + (tak14 (- y 1) z x) + (tak58 (- z 1) x y))))) + (: tak74 (Integer Integer Integer -> Integer)) + (define (tak74 x y z) + (cond ((not (< y x)) z) + (else (tak75 (tak75 (- x 1) y z) + (tak25 (- y 1) z x) + (tak75 (- z 1) x y))))) + (: tak75 (Integer Integer Integer -> Integer)) + (define (tak75 x y z) + (cond ((not (< y x)) z) + (else (tak76 (tak12 (- x 1) y z) + (tak36 (- y 1) z x) + (tak92 (- z 1) x y))))) + (: tak76 (Integer Integer Integer -> Integer)) + (define (tak76 x y z) + (cond ((not (< y x)) z) + (else (tak77 (tak49 (- x 1) y z) + (tak47 (- y 1) z x) + (tak9 (- z 1) x y))))) + (: tak77 (Integer Integer Integer -> Integer)) + (define (tak77 x y z) + (cond ((not (< y x)) z) + (else (tak78 (tak86 (- x 1) y z) + (tak58 (- y 1) z x) + (tak26 (- z 1) x y))))) + (: tak78 (Integer Integer Integer -> Integer)) + (define (tak78 x y z) + (cond ((not (< y x)) z) + (else (tak79 (tak23 (- x 1) y z) + (tak69 (- y 1) z x) + (tak43 (- z 1) x y))))) + (: tak79 (Integer Integer Integer -> Integer)) + (define (tak79 x y z) + (cond ((not (< y x)) z) + (else (tak80 (tak60 (- x 1) y z) + (tak80 (- y 1) z x) + (tak60 (- z 1) x y))))) + (: tak80 (Integer Integer Integer -> Integer)) + (define (tak80 x y z) + (cond ((not (< y x)) z) + (else (tak81 (tak97 (- x 1) y z) + (tak91 (- y 1) z x) + (tak77 (- z 1) x y))))) + (: tak81 (Integer Integer Integer -> Integer)) + (define (tak81 x y z) + (cond ((not (< y x)) z) + (else (tak82 (tak34 (- x 1) y z) + (tak2 (- y 1) z x) + (tak94 (- z 1) x y))))) + (: tak82 (Integer Integer Integer -> Integer)) + (define (tak82 x y z) + (cond ((not (< y x)) z) + (else (tak83 (tak71 (- x 1) y z) + (tak13 (- y 1) z x) + (tak11 (- z 1) x y))))) + (: tak83 (Integer Integer Integer -> Integer)) + (define (tak83 x y z) + (cond ((not (< y x)) z) + (else (tak84 (tak8 (- x 1) y z) + (tak24 (- y 1) z x) + (tak28 (- z 1) x y))))) + (: tak84 (Integer Integer Integer -> Integer)) + (define (tak84 x y z) + (cond ((not (< y x)) z) + (else (tak85 (tak45 (- x 1) y z) + (tak35 (- y 1) z x) + (tak45 (- z 1) x y))))) + (: tak85 (Integer Integer Integer -> Integer)) + (define (tak85 x y z) + (cond ((not (< y x)) z) + (else (tak86 (tak82 (- x 1) y z) + (tak46 (- y 1) z x) + (tak62 (- z 1) x y))))) + (: tak86 (Integer Integer Integer -> Integer)) + (define (tak86 x y z) + (cond ((not (< y x)) z) + (else (tak87 (tak19 (- x 1) y z) + (tak57 (- y 1) z x) + (tak79 (- z 1) x y))))) + (: tak87 (Integer Integer Integer -> Integer)) + (define (tak87 x y z) + (cond ((not (< y x)) z) + (else (tak88 (tak56 (- x 1) y z) + (tak68 (- y 1) z x) + (tak96 (- z 1) x y))))) + (: tak88 (Integer Integer Integer -> Integer)) + (define (tak88 x y z) + (cond ((not (< y x)) z) + (else (tak89 (tak93 (- x 1) y z) + (tak79 (- y 1) z x) + (tak13 (- z 1) x y))))) + (: tak89 (Integer Integer Integer -> Integer)) + (define (tak89 x y z) + (cond ((not (< y x)) z) + (else (tak90 (tak30 (- x 1) y z) + (tak90 (- y 1) z x) + (tak30 (- z 1) x y))))) + (: tak90 (Integer Integer Integer -> Integer)) + (define (tak90 x y z) + (cond ((not (< y x)) z) + (else (tak91 (tak67 (- x 1) y z) + (tak1 (- y 1) z x) + (tak47 (- z 1) x y))))) + (: tak91 (Integer Integer Integer -> Integer)) + (define (tak91 x y z) + (cond ((not (< y x)) z) + (else (tak92 (tak4 (- x 1) y z) + (tak12 (- y 1) z x) + (tak64 (- z 1) x y))))) + (: tak92 (Integer Integer Integer -> Integer)) + (define (tak92 x y z) + (cond ((not (< y x)) z) + (else (tak93 (tak41 (- x 1) y z) + (tak23 (- y 1) z x) + (tak81 (- z 1) x y))))) + (: tak93 (Integer Integer Integer -> Integer)) + (define (tak93 x y z) + (cond ((not (< y x)) z) + (else (tak94 (tak78 (- x 1) y z) + (tak34 (- y 1) z x) + (tak98 (- z 1) x y))))) + (: tak94 (Integer Integer Integer -> Integer)) + (define (tak94 x y z) + (cond ((not (< y x)) z) + (else (tak95 (tak15 (- x 1) y z) + (tak45 (- y 1) z x) + (tak15 (- z 1) x y))))) + (: tak95 (Integer Integer Integer -> Integer)) + (define (tak95 x y z) + (cond ((not (< y x)) z) + (else (tak96 (tak52 (- x 1) y z) + (tak56 (- y 1) z x) + (tak32 (- z 1) x y))))) + (: tak96 (Integer Integer Integer -> Integer)) + (define (tak96 x y z) + (cond ((not (< y x)) z) + (else (tak97 (tak89 (- x 1) y z) + (tak67 (- y 1) z x) + (tak49 (- z 1) x y))))) + (: tak97 (Integer Integer Integer -> Integer)) + (define (tak97 x y z) + (cond ((not (< y x)) z) + (else (tak98 (tak26 (- x 1) y z) + (tak78 (- y 1) z x) + (tak66 (- z 1) x y))))) + (: tak98 (Integer Integer Integer -> Integer)) + (define (tak98 x y z) + (cond ((not (< y x)) z) + (else (tak99 (tak63 (- x 1) y z) + (tak89 (- y 1) z x) + (tak83 (- z 1) x y))))) + (: tak99 (Integer Integer Integer -> Integer)) + (define (tak99 x y z) + (cond ((not (< y x)) z) + (else (tak0 (tak0 (- x 1) y z) + (tak0 (- y 1) z x) + (tak0 (- z 1) x y))))) + + (tak0 x y z)) + +;;; call: (tak0 18 12 6) + +(let ((input (with-input-from-file "input.txt" read))) + (time + (let: loop : Integer ((n : Integer 500) (v : Integer 0)) + (if (zero? n) + v + (loop (- n 1) (tak 18 12 (if input 6 0))))))) diff --git a/collects/tests/racket/benchmarks/common/triangle-typed.rkt b/collects/tests/racket/benchmarks/common/triangle-typed.rkt new file mode 100644 index 0000000000..e8b8fd3838 --- /dev/null +++ b/collects/tests/racket/benchmarks/common/triangle-typed.rkt @@ -0,0 +1,99 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; File: triangle.sch +; Description: TRIANGLE benchmark +; Author: Richard Gabriel +; Created: 12-Apr-85 +; Modified: 12-Apr-85 10:30:32 (Bob Shaw) +; 11-Aug-87 (Will Clinger) +; 22-Jan-88 (Will Clinger) +; 10-May-10 (Vincent St-Amour) +; Language: Typed Scheme +; Status: Public Domain +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; TRIANG -- Board game benchmark. + +#lang typed/scheme/base + +(: *board* (Vectorof Integer)) +(define *board* (make-vector 16 1)) +(: *sequence* (Vectorof Integer)) +(define *sequence* (make-vector 14 0)) +(: *a* (Vectorof Integer)) +(define *a* (make-vector 37)) +(: *b* (Vectorof Integer)) +(define *b* (make-vector 37)) +(: *c* (Vectorof Integer)) +(define *c* (make-vector 37)) +(: *answer* (Listof (Listof Integer))) +(define *answer* '()) +(: *final* (Listof Integer)) +(define *final* '()) + +(: last-position ( -> Integer)) +(define (last-position) + (do ((i 1 (+ i 1))) + ((or (= i 16) (= 1 (vector-ref *board* i))) + (if (= i 16) 0 i)))) + +(: ttry (Integer Integer -> Any)) +(define (ttry i depth) + (cond ((= depth 14) + (let ((lp (last-position))) + (if (not (member lp *final*)) + (set! *final* (cons lp *final*)) + #t)) + (set! *answer* + (cons (cdr (vector->list *sequence*)) *answer*)) + #t) + ((and (= 1 (vector-ref *board* (vector-ref *a* i))) + (= 1 (vector-ref *board* (vector-ref *b* i))) + (= 0 (vector-ref *board* (vector-ref *c* i)))) + (vector-set! *board* (vector-ref *a* i) 0) + (vector-set! *board* (vector-ref *b* i) 0) + (vector-set! *board* (vector-ref *c* i) 1) + (vector-set! *sequence* depth i) + (do ((j 0 (+ j 1)) + (depth (+ depth 1))) + ((or (= j 36) (ttry j depth)) #f)) + (vector-set! *board* (vector-ref *a* i) 1) + (vector-set! *board* (vector-ref *b* i) 1) + (vector-set! *board* (vector-ref *c* i) 0) '()) + (else #f))) + +(: gogogo (Integer -> Any)) +(define (gogogo i) + (let ((*answer* '()) + (*final* '())) + (ttry i 1))) + +(for-each (lambda: ((i : Integer) (x : Integer)) (vector-set! *a* i x)) + '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36) + '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 + 13 7 8 4 4 7 11 8 12 13 6 10 + 15 9 14 13 13 14 15 9 10 + 6 6)) +(for-each (lambda: ((i : Integer) (x : Integer)) (vector-set! *b* i x)) + '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36) + '(2 4 7 5 8 9 3 6 10 5 9 8 + 12 13 14 8 9 5 2 4 7 5 8 + 9 3 6 10 5 9 8 12 13 14 + 8 9 5 5)) +(for-each (lambda: ((i : Integer) (x : Integer)) (vector-set! *c* i x)) + '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 + 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36) + '(4 7 11 8 12 13 6 10 15 9 14 13 + 13 14 15 9 10 6 1 2 4 3 5 6 1 + 3 6 2 5 4 11 12 13 7 8 4 4)) +(vector-set! *board* 5 0) + +;;; call: (gogogo 22)) + +(time (let: loop : 'done ((n : Integer 100000)) + (if (zero? n) + 'done + (begin + (gogogo 22) + (loop (- n 1))))))