suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Ported some more of the common benchmarks to Typed Scheme.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-05-11 18:55:29 -04:00
parent 1e15826159
commit 20cd21440f
7 changed files with 2360 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

723
collects/tests/racket/benchmarks/common/graphs-typed.rkt Normal file
View File

@ -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))))))))

199
collects/tests/racket/benchmarks/common/puzzle-typed.rkt Normal file
View File

@ -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))

32
collects/tests/racket/benchmarks/common/tak-typed.rkt Normal file
View File

@ -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)))))))

49
collects/tests/racket/benchmarks/common/takl-typed.rkt Normal file
View File

@ -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)))

627
collects/tests/racket/benchmarks/common/takr-typed.rkt Normal file
View File

@ -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)))))))

631
collects/tests/racket/benchmarks/common/takr2-typed.rkt Normal file
View File

@ -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)))))))

99
collects/tests/racket/benchmarks/common/triangle-typed.rkt Normal file
View File

@ -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))))))