Corrected some of the typed benchmarks to typecheck with Naturals as indices.
This commit is contained in:
Vincent St-Amour
parent
2229173b82
commit
64ff5555fb
|
|
@ -27,16 +27,16 @@
|
|||
(define (fft areal aimag)
|
||||
(let: ((ar : (Vectorof Complex) (vector))
|
||||
(ai : (Vectorof Complex) (vector))
|
||||
(i : Integer 0)
|
||||
(j : Integer 0)
|
||||
(k : Integer 0)
|
||||
(m : Integer 0)
|
||||
(n : Integer 0)
|
||||
(le : Integer 0)
|
||||
(le1 : Integer 0)
|
||||
(ip : Integer 0)
|
||||
(nv2 : Integer 0)
|
||||
(nm1 : Integer 0)
|
||||
(i : Natural 0)
|
||||
(j : Natural 0)
|
||||
(k : Natural 0)
|
||||
(m : Natural 0)
|
||||
(n : Natural 0)
|
||||
(le : Natural 0)
|
||||
(le1 : Natural 0)
|
||||
(ip : Natural 0)
|
||||
(nv2 : Natural 0)
|
||||
(nm1 : Natural 0)
|
||||
(ur : Complex 0)
|
||||
(ui : Complex 0)
|
||||
(wr : Complex 0)
|
||||
|
|
@ -47,9 +47,9 @@
|
|||
(set! ar areal)
|
||||
(set! ai aimag)
|
||||
(set! n (vector-length ar))
|
||||
(set! n (- n 1))
|
||||
(set! n (abs (- n 1))) ; abs is to appease the typechecker
|
||||
(set! nv2 (quotient n 2))
|
||||
(set! nm1 (- n 1))
|
||||
(set! nm1 (abs (- n 1))) ; abs is to appease the typechecker
|
||||
(set! m 0) ;compute m = log(n)
|
||||
(set! i 1)
|
||||
(let loop ()
|
||||
|
|
@ -74,7 +74,7 @@
|
|||
(set! k nv2)
|
||||
(let l6 ()
|
||||
(cond ((< k j)
|
||||
(set! j (- j k))
|
||||
(set! j (abs (- j k))) ; abs is to appease the typechecker
|
||||
(set! k (quotient k 2))
|
||||
(l6))))
|
||||
(set! j (+ j k))
|
||||
|
|
@ -82,7 +82,7 @@
|
|||
(cond ((< i n)
|
||||
(l3))))
|
||||
(do: : Void
|
||||
((l : Integer 1 (+ l 1))) ;loop thru stages (syntax converted
|
||||
((l : Natural 1 (+ l 1))) ;loop thru stages (syntax converted
|
||||
((> l m)) ; from old MACLISP style \bs)
|
||||
(set! le (expt 2 l))
|
||||
(set! le1 (quotient le 2))
|
||||
|
|
@ -92,11 +92,11 @@
|
|||
(set! wi (sin (/ pi le1)))
|
||||
;; loop thru butterflies
|
||||
(do: : Void
|
||||
((j : Integer 1 (+ j 1)))
|
||||
((j : Natural 1 (+ j 1)))
|
||||
((> j le1))
|
||||
;; do a butterfly
|
||||
(do: : Void
|
||||
((i : Integer j (+ i le)))
|
||||
((i : Natural j (+ i le)))
|
||||
((> i n))
|
||||
(set! ip (+ i le1))
|
||||
(set! tr (- (* (vector-ref ar ip) ur)
|
||||
|
|
@ -118,7 +118,7 @@
|
|||
(: fft-bench ( -> Void))
|
||||
(define (fft-bench)
|
||||
(do: : Void
|
||||
((ntimes : Integer 0 (+ ntimes 1)))
|
||||
((ntimes : Natural 0 (+ ntimes 1)))
|
||||
((= ntimes 5000))
|
||||
(fft *re* *im*)))
|
||||
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@
|
|||
; 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))))
|
||||
(: proc->vector (All (X) (Natural (Natural -> X) -> (Vectorof X))))
|
||||
(define proc->vector
|
||||
(lambda (size f)
|
||||
'(assert (and (integer? size)
|
||||
|
|
@ -100,31 +100,31 @@
|
|||
(define vec-map
|
||||
(lambda (vec proc)
|
||||
(proc->vector (vector-length vec)
|
||||
(lambda: ((i : Integer))
|
||||
(lambda: ((i : Natural))
|
||||
(proc (vector-ref vec i))))))
|
||||
|
||||
; Given limit, return the list 0, 1, ..., limit-1.
|
||||
(: giota (Integer -> (Listof Integer)))
|
||||
(: giota (Natural -> (Listof Natural)))
|
||||
(define giota
|
||||
(lambda (limit)
|
||||
'(assert (and (integer? limit)
|
||||
(exact? limit)
|
||||
(>= limit 0))
|
||||
limit)
|
||||
(let: _-*- : (Listof Integer)
|
||||
((limit : Integer
|
||||
(let: _-*- : (Listof Natural)
|
||||
((limit : Natural
|
||||
limit)
|
||||
(res : (Listof Integer)
|
||||
(res : (Listof Natural)
|
||||
'()))
|
||||
(if (zero? limit)
|
||||
res
|
||||
(let ((limit
|
||||
(- limit 1)))
|
||||
(sub1 limit)))
|
||||
(_-*- limit
|
||||
(cons limit res)))))))
|
||||
|
||||
; Fold over the integers [0, limit).
|
||||
(: gnatural-fold (All (X) (Integer (Integer X -> X) X -> X)))
|
||||
(: gnatural-fold (All (X) (Natural (Natural X -> X) X -> X)))
|
||||
(define gnatural-fold
|
||||
(lambda (limit folder state)
|
||||
'(assert (and (integer? limit)
|
||||
|
|
@ -141,7 +141,7 @@
|
|||
state))))
|
||||
|
||||
; Iterate over the integers [0, limit).
|
||||
(: gnatural-for-each (Integer (Integer -> Any) -> Void))
|
||||
(: gnatural-for-each (Natural (Natural -> Any) -> Void))
|
||||
(define gnatural-for-each
|
||||
(lambda (limit proc!)
|
||||
'(assert (and (integer? limit)
|
||||
|
|
@ -151,12 +151,12 @@
|
|||
'(assert (procedure? proc!)
|
||||
proc!)
|
||||
(do: : Void
|
||||
((i : Integer 0
|
||||
((i : Natural 0
|
||||
(+ i 1)))
|
||||
((= i limit))
|
||||
(proc! i))))
|
||||
|
||||
(: natural-for-all? (Integer (Integer -> Boolean) -> Boolean))
|
||||
(: natural-for-all? (Natural (Natural -> Boolean) -> Boolean))
|
||||
(define natural-for-all?
|
||||
(lambda (limit ok?)
|
||||
'(assert (and (integer? limit)
|
||||
|
|
@ -171,7 +171,7 @@
|
|||
(and (ok? i)
|
||||
(_-*- (+ i 1)))))))
|
||||
|
||||
(: natural-there-exists? (Integer (Integer -> Boolean) -> Boolean))
|
||||
(: natural-there-exists? (Natural (Natural -> Boolean) -> Boolean))
|
||||
(define natural-there-exists?
|
||||
(lambda (limit ok?)
|
||||
'(assert (and (integer? limit)
|
||||
|
|
@ -329,10 +329,10 @@
|
|||
; 3->2, 2->3
|
||||
; ...
|
||||
(: make-minimal? (All (State)
|
||||
(Integer ->
|
||||
(Integer
|
||||
(Natural ->
|
||||
(Natural
|
||||
Graph
|
||||
((Vectorof Integer)
|
||||
((Vectorof Natural)
|
||||
Boolean
|
||||
(Boolean -> Boolean)
|
||||
-> Boolean)
|
||||
|
|
@ -344,10 +344,10 @@
|
|||
(exact? max-size)
|
||||
(>= max-size 0))
|
||||
max-size)
|
||||
(let: ((iotas : (Vectorof (Listof Integer))
|
||||
(let: ((iotas : (Vectorof (Listof Natural))
|
||||
(proc->vector (+ max-size 1)
|
||||
giota))
|
||||
(perm : (Vectorof Integer)
|
||||
(perm : (Vectorof Natural)
|
||||
(make-vector max-size 0)))
|
||||
(lambda (size graph folder state)
|
||||
'(assert (and (integer? size)
|
||||
|
|
@ -361,10 +361,10 @@
|
|||
folder)
|
||||
(fold-over-perm-tree
|
||||
(vector-ref iotas size)
|
||||
(lambda: ((perm-x : Integer)
|
||||
(x : Integer)
|
||||
(lambda: ((perm-x : Natural)
|
||||
(x : Natural)
|
||||
(state : Boolean)
|
||||
(deeper : (Integer Boolean
|
||||
(deeper : (Natural Boolean
|
||||
-> Boolean))
|
||||
(accross : (Boolean
|
||||
-> Boolean)))
|
||||
|
|
@ -380,7 +380,7 @@
|
|||
(else
|
||||
(error "can't happen"))))
|
||||
0
|
||||
(lambda: ((leaf-depth : Integer)
|
||||
(lambda: ((leaf-depth : Natural)
|
||||
(state : Boolean)
|
||||
(accross : (Boolean -> Boolean)))
|
||||
'(assert (eqv? leaf-depth size)
|
||||
|
|
@ -392,7 +392,7 @@
|
|||
; 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
|
||||
(: cmp-next-vertex (Graph (Vectorof Natural) Natural Natural
|
||||
-> (U 'less 'equal 'more)))
|
||||
(define cmp-next-vertex
|
||||
(lambda (graph perm x perm-x)
|
||||
|
|
@ -430,7 +430,7 @@
|
|||
|
||||
;;; ==== rdg.ss ====
|
||||
|
||||
(define-type RDG (Vectorof (Listof Integer)))
|
||||
(define-type RDG (Vectorof (Listof Natural)))
|
||||
|
||||
; Fold over rooted directed graphs with bounded out-degree.
|
||||
; Size is the number of vertices (including the root). Max-out is the
|
||||
|
|
@ -439,8 +439,8 @@
|
|||
; 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
|
||||
(: fold-over-rdg (All (State) (Exact-Positive-Integer
|
||||
Natural
|
||||
(RDG State -> State)
|
||||
State
|
||||
-> State)))
|
||||
|
|
@ -456,20 +456,20 @@
|
|||
max-out)
|
||||
'(assert (procedure? folder)
|
||||
folder)
|
||||
(let*: ((root : Integer
|
||||
(- size 1))
|
||||
(let*: ((root : Natural
|
||||
(sub1 size))
|
||||
(edge? : Graph
|
||||
(proc->vector size
|
||||
(lambda: ((from : Integer))
|
||||
(lambda: ((from : Natural))
|
||||
(ann (make-vector size #f)
|
||||
(Vectorof Boolean)))))
|
||||
(edges : RDG
|
||||
(make-vector size '()))
|
||||
(out-degrees : (Vectorof Integer)
|
||||
(out-degrees : (Vectorof Natural)
|
||||
(make-vector size 0))
|
||||
(minimal-folder : (Integer
|
||||
(minimal-folder : (Natural
|
||||
Graph
|
||||
((Vectorof Integer)
|
||||
((Vectorof Natural)
|
||||
Boolean
|
||||
(Boolean -> Boolean)
|
||||
-> Boolean)
|
||||
|
|
@ -478,22 +478,22 @@
|
|||
;; 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)
|
||||
(non-root-minimal? : (Natural -> Boolean)
|
||||
(let ((cont
|
||||
(lambda: ((perm : (Vectorof Integer))
|
||||
(lambda: ((perm : (Vectorof Natural))
|
||||
(state : Boolean)
|
||||
(accross : (Boolean -> Boolean)))
|
||||
'(assert (eq? state #t)
|
||||
state)
|
||||
(accross #t))))
|
||||
(lambda: ((size : Integer))
|
||||
(lambda: ((size : Natural))
|
||||
(minimal-folder size
|
||||
edge?
|
||||
cont
|
||||
#t))))
|
||||
(root-minimal? : ( -> Boolean)
|
||||
(let ((cont
|
||||
(lambda: ((perm : (Vectorof Integer))
|
||||
(lambda: ((perm : (Vectorof Natural))
|
||||
(state : Boolean)
|
||||
(accross : (Boolean -> Boolean)))
|
||||
'(assert (eq? state #t)
|
||||
|
|
@ -511,7 +511,7 @@
|
|||
cont
|
||||
#t)))))
|
||||
(let: _-*- : State
|
||||
((vertex : Integer
|
||||
((vertex : Natural
|
||||
0)
|
||||
(state : State
|
||||
state))
|
||||
|
|
@ -533,11 +533,11 @@
|
|||
(from-root
|
||||
(vector-ref edge? root)))
|
||||
(let: _-*- : State
|
||||
((v : Integer
|
||||
((v : Natural
|
||||
0)
|
||||
(outs : Integer
|
||||
(outs : Natural
|
||||
0)
|
||||
(efr : (Listof Integer)
|
||||
(efr : (Listof Natural)
|
||||
'())
|
||||
(efrr : (Listof (Vectorof Boolean))
|
||||
'())
|
||||
|
|
@ -568,7 +568,7 @@
|
|||
(vector-set! edges root efr)
|
||||
(folder
|
||||
(proc->vector size
|
||||
(lambda: ((i : Integer))
|
||||
(lambda: ((i : Natural))
|
||||
(vector-ref edges i)))
|
||||
state))
|
||||
(else
|
||||
|
|
@ -658,32 +658,32 @@
|
|||
|
||||
; Given a vector which maps vertex to out-going-edge list,
|
||||
; return a vector which gives reachability.
|
||||
(: make-reach? (Integer RDG -> Graph))
|
||||
(: make-reach? (Natural RDG -> Graph))
|
||||
(define make-reach?
|
||||
(lambda (size vertex->out)
|
||||
(let ((res
|
||||
(proc->vector size
|
||||
(lambda: ((v : Integer))
|
||||
(lambda: ((v : Natural))
|
||||
(let: ((from-v : (Vectorof Boolean)
|
||||
(make-vector size #f)))
|
||||
(vector-set! from-v v #t)
|
||||
(for-each
|
||||
(lambda: ((x : Integer))
|
||||
(lambda: ((x : Natural))
|
||||
(vector-set! from-v x #t))
|
||||
(vector-ref vertex->out v))
|
||||
from-v)))))
|
||||
(gnatural-for-each size
|
||||
(lambda: ((m : Integer))
|
||||
(lambda: ((m : Natural))
|
||||
(let ((from-m
|
||||
(vector-ref res m)))
|
||||
(gnatural-for-each size
|
||||
(lambda: ((f : Integer))
|
||||
(lambda: ((f : Natural))
|
||||
(let ((from-f
|
||||
(vector-ref res f)))
|
||||
(if (vector-ref from-f m); [wdc - was when]
|
||||
(begin
|
||||
(gnatural-for-each size
|
||||
(lambda: ((t : Integer))
|
||||
(lambda: ((t : Natural))
|
||||
(if (vector-ref from-m t)
|
||||
(begin ; [wdc - was when]
|
||||
(vector-set! from-f t #t))
|
||||
|
|
@ -707,11 +707,11 @@
|
|||
(let ((input (with-input-from-file "input.txt" read)))
|
||||
(time
|
||||
(let: loop : (Listof RDG)
|
||||
((n : Integer 45) (v : (Listof RDG) '()))
|
||||
((n : Natural 45) (v : (Listof RDG) '()))
|
||||
(if (zero? n)
|
||||
v
|
||||
(loop (- n 1)
|
||||
(fold-over-rdg (if input 6 0)
|
||||
(loop (sub1 n)
|
||||
(fold-over-rdg (if input 6 1)
|
||||
2
|
||||
(ann cons (RDG (Listof RDG) -> (Listof RDG)))
|
||||
(ann '() (Listof RDG))))))))
|
||||
|
|
|
|||
|
|
@ -642,7 +642,7 @@
|
|||
(if (zero? n)
|
||||
v
|
||||
(loop (- n 1)
|
||||
(fold-over-rdg (if input 6 0)
|
||||
(fold-over-rdg (if input 6 1)
|
||||
2
|
||||
cons
|
||||
'()))))))
|
||||
|
|
|
|||
|
|
@ -2,16 +2,16 @@
|
|||
|
||||
(define-type Radical (Rec Radical (U 'C 'H 'BCP 'CCP (Vectorof Radical))))
|
||||
|
||||
(: gen (Integer -> (Vectorof (Listof Radical))))
|
||||
(: gen (Exact-Positive-Integer -> (Vectorof (Listof Radical))))
|
||||
(define (gen n)
|
||||
(let*: ((n/2 : Integer (quotient n 2))
|
||||
(let*: ((n/2 : Natural (quotient n 2))
|
||||
(radicals : (Vectorof (Listof Radical)) (make-vector (+ n/2 1) '(H))))
|
||||
|
||||
(: rads-of-size (Integer -> (Listof Radical)))
|
||||
(: rads-of-size (Exact-Positive-Integer -> (Listof Radical)))
|
||||
(define (rads-of-size n)
|
||||
(let: loop1 : (Listof Radical)
|
||||
((ps : (Listof (Vectorof Integer))
|
||||
(three-partitions (- n 1)))
|
||||
((ps : (Listof (Vectorof Natural))
|
||||
(three-partitions (sub1 n)))
|
||||
(lst : (Listof Radical)
|
||||
'()))
|
||||
(if (null? ps)
|
||||
|
|
@ -55,7 +55,7 @@
|
|||
(loop4 (cdr rads3)
|
||||
lst))))))))))))
|
||||
|
||||
(: bcp-generator (Integer -> (Listof Radical)))
|
||||
(: bcp-generator (Natural -> (Listof Radical)))
|
||||
(define (bcp-generator j)
|
||||
(if (odd? j)
|
||||
'()
|
||||
|
|
@ -79,11 +79,11 @@
|
|||
(loop2 (cdr rads2)
|
||||
lst))))))))
|
||||
|
||||
(: ccp-generator (Integer -> (Listof Radical)))
|
||||
(: ccp-generator (Exact-Positive-Integer -> (Listof Radical)))
|
||||
(define (ccp-generator j)
|
||||
(let: loop1 : (Listof Radical)
|
||||
((ps : (Listof (Vectorof Integer))
|
||||
(four-partitions (- j 1)))
|
||||
((ps : (Listof (Vectorof Natural))
|
||||
(four-partitions (sub1 j)))
|
||||
(lst : (Listof Radical)
|
||||
'()))
|
||||
(if (null? ps)
|
||||
|
|
@ -143,10 +143,10 @@
|
|||
(vector-set! radicals i (rads-of-size i))
|
||||
(loop (+ i 1)))))))
|
||||
|
||||
(: three-partitions (Integer -> (Listof (Vectorof Integer))))
|
||||
(: three-partitions (Natural -> (Listof (Vectorof Natural))))
|
||||
(define (three-partitions m)
|
||||
(let: loop1 : (Listof (Vectorof Integer))
|
||||
((lst : (Listof (Vectorof Integer)) '())
|
||||
(let: loop1 : (Listof (Vectorof Natural))
|
||||
((lst : (Listof (Vectorof Natural)) '())
|
||||
(nc1 : Integer (quotient m 3)))
|
||||
(if (< nc1 0)
|
||||
lst
|
||||
|
|
@ -154,14 +154,17 @@
|
|||
(nc2 (quotient (- m nc1) 2)))
|
||||
(if (< nc2 nc1)
|
||||
(loop1 lst
|
||||
(- nc1 1))
|
||||
(loop2 (cons (vector nc1 nc2 (- m (+ nc1 nc2))) lst)
|
||||
(- nc2 1)))))))
|
||||
(sub1 nc1))
|
||||
(loop2 (cons (vector (abs nc1)
|
||||
(abs nc2)
|
||||
(abs (- m (+ nc1 nc2)))) ; abs is to appease the typechecker
|
||||
lst)
|
||||
(sub1 nc2)))))))
|
||||
|
||||
(: four-partitions (Integer -> (Listof (Vectorof Integer))))
|
||||
(: four-partitions (Natural -> (Listof (Vectorof Natural))))
|
||||
(define (four-partitions m)
|
||||
(let: loop1 : (Listof (Vectorof Integer))
|
||||
((lst : (Listof (Vectorof Integer)) '())
|
||||
(let: loop1 : (Listof (Vectorof Natural))
|
||||
((lst : (Listof (Vectorof Natural)) '())
|
||||
(nc1 : Integer (quotient m 4)))
|
||||
(if (< nc1 0)
|
||||
lst
|
||||
|
|
@ -169,16 +172,20 @@
|
|||
(nc2 (quotient (- m nc1) 3)))
|
||||
(if (< nc2 nc1)
|
||||
(loop1 lst
|
||||
(- nc1 1))
|
||||
(sub1 nc1))
|
||||
(let ((start (max nc2 (- (quotient (+ m 1) 2) (+ nc1 nc2)))))
|
||||
(let loop3 ((lst lst)
|
||||
(nc3 (quotient (- m (+ nc1 nc2)) 2)))
|
||||
(if (< nc3 start)
|
||||
(loop2 lst (- nc2 1))
|
||||
(loop3 (cons (vector nc1 nc2 nc3 (- m (+ nc1 (+ nc2 nc3)))) lst)
|
||||
(- nc3 1))))))))))
|
||||
(loop2 lst (sub1 nc2))
|
||||
(loop3 (cons (vector (abs nc1)
|
||||
(abs nc2)
|
||||
(abs nc3)
|
||||
(abs (- m (+ nc1 (+ nc2 nc3))))) ; abs is to appease the typechecker
|
||||
lst)
|
||||
(sub1 nc3))))))))))
|
||||
|
||||
(: nb (Integer -> Integer))
|
||||
(: nb (Exact-Positive-Integer -> Natural))
|
||||
(define (nb n)
|
||||
(let ((x (gen n)))
|
||||
(+ (length (vector-ref x 0))
|
||||
|
|
@ -186,9 +193,9 @@
|
|||
|
||||
(let ((input (with-input-from-file "input.txt" read)))
|
||||
(time
|
||||
(let: loop : Integer
|
||||
((n : Integer 4000) (v : Integer 0))
|
||||
(let: loop : Natural
|
||||
((n : Natural 4000) (v : Natural 0))
|
||||
(if (zero? n)
|
||||
v
|
||||
(loop (- n 1) (nb (if input 17 0)))))))
|
||||
(loop (sub1 n) (nb (if input 17 1)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -172,4 +172,4 @@
|
|||
(let loop ((n 4000) (v 0))
|
||||
(if (zero? n)
|
||||
v
|
||||
(loop (- n 1) (nb (if input 17 0)))))))
|
||||
(loop (- n 1) (nb (if input 17 1)))))))
|
||||
|
|
|
|||
|
|
@ -10,11 +10,11 @@
|
|||
; Status: Public Domain
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(: iota (Integer -> (Listof Integer)))
|
||||
(: iota (Natural -> (Listof Natural)))
|
||||
(define (iota n)
|
||||
(do: : (Listof Integer)
|
||||
((n : Integer n (- n 1))
|
||||
(list : (Listof Integer) '() (cons (- n 1) list)))
|
||||
(do: : (Listof Natural)
|
||||
((n : Natural n (sub1 n))
|
||||
(list : (Listof Natural) '() (cons (sub1 n) list)))
|
||||
((zero? n) list)))
|
||||
|
||||
;;; PUZZLE -- Forest Baskett's Puzzle benchmark, originally written in Pascal.
|
||||
|
|
@ -23,17 +23,17 @@
|
|||
(define classmax 3)
|
||||
(define typemax 12)
|
||||
|
||||
(: *iii* Integer)
|
||||
(: *iii* Natural)
|
||||
(define *iii* 0)
|
||||
(: *kount* Integer)
|
||||
(: *kount* Natural)
|
||||
(define *kount* 0)
|
||||
(define *d* 8)
|
||||
|
||||
(: *piececount* (Vectorof Integer))
|
||||
(define *piececount* (make-vector (+ classmax 1) 0))
|
||||
(: *class* (Vectorof Integer))
|
||||
(: *class* (Vectorof Natural))
|
||||
(define *class* (make-vector (+ typemax 1) 0))
|
||||
(: *piecemax* (Vectorof Integer))
|
||||
(: *piecemax* (Vectorof Natural))
|
||||
(define *piecemax* (make-vector (+ typemax 1) 0))
|
||||
(: *puzzle* (Vectorof Boolean))
|
||||
(define *puzzle* (make-vector (+ size 1) #f))
|
||||
|
|
@ -44,13 +44,13 @@
|
|||
(ann (vector #f)
|
||||
(Vectorof Boolean))))
|
||||
(define nothing
|
||||
(for-each (lambda: ((i : Integer))
|
||||
(for-each (lambda: ((i : Natural))
|
||||
(vector-set! *p* i
|
||||
(ann (make-vector (+ size 1) #f)
|
||||
(Vectorof Boolean))))
|
||||
(iota (+ typemax 1))))
|
||||
|
||||
(: fit (Integer Integer -> Boolean))
|
||||
(: fit (Natural Natural -> Boolean))
|
||||
(define (fit i j)
|
||||
(let ((end (vector-ref *piecemax* i)))
|
||||
(do ((k 0 (+ k 1)))
|
||||
|
|
@ -59,7 +59,7 @@
|
|||
(vector-ref *puzzle* (+ j k))))
|
||||
(if (> k end) #t #f)))))
|
||||
|
||||
(: place (Integer Integer -> Integer))
|
||||
(: place (Natural Natural -> Natural))
|
||||
(define (place i j)
|
||||
(let ((end (vector-ref *piecemax* i)))
|
||||
(do ((k 0 (+ k 1)))
|
||||
|
|
@ -76,7 +76,7 @@
|
|||
; (display "*Puzzle* filled")
|
||||
(if (> k size) 0 k)))))
|
||||
|
||||
(: puzzle-remove (Integer Integer -> Void))
|
||||
(: puzzle-remove (Natural Natural -> Void))
|
||||
(define (puzzle-remove i j)
|
||||
(let ((end (vector-ref *piecemax* i)))
|
||||
(do ((k 0 (+ k 1)))
|
||||
|
|
@ -89,13 +89,13 @@
|
|||
(+ (vector-ref *piececount* (vector-ref *class* i)) 1))))
|
||||
|
||||
|
||||
(: trial (Integer -> Any))
|
||||
(: trial (Natural -> Any))
|
||||
(define (trial j)
|
||||
(let: ((k : Integer 0))
|
||||
(let: ((k : Natural 0))
|
||||
(call-with-current-continuation
|
||||
(lambda: ((return : (Boolean -> Nothing)))
|
||||
(do: : Any
|
||||
((i : Integer 0 (+ i 1)))
|
||||
((i : Natural 0 (+ i 1)))
|
||||
((> i typemax) (set! *kount* (+ *kount* 1)) '())
|
||||
(cond
|
||||
((not
|
||||
|
|
@ -111,7 +111,7 @@
|
|||
(return #t))
|
||||
(else (puzzle-remove i j))))))))))))
|
||||
|
||||
(: trial-output (Integer Integer -> Void))
|
||||
(: trial-output (Natural Natural -> Void))
|
||||
(define (trial-output x y)
|
||||
(newline)
|
||||
(display (string-append "Piece "
|
||||
|
|
@ -120,17 +120,17 @@
|
|||
(number->string y #;'(int))
|
||||
".")))
|
||||
|
||||
(: definePiece (Integer Integer Integer Integer -> Void))
|
||||
(: definePiece (Natural Natural Natural Natural -> Void))
|
||||
(define (definePiece iclass ii jj kk)
|
||||
(let: ((index : Integer 0))
|
||||
(let: ((index : Natural 0))
|
||||
(do: : Void
|
||||
((i : Integer 0 (+ i 1)))
|
||||
((i : Natural 0 (+ i 1)))
|
||||
((> i ii))
|
||||
(do: : Void
|
||||
((j : Integer 0 (+ j 1)))
|
||||
((j : Natural 0 (+ j 1)))
|
||||
((> j jj))
|
||||
(do: : Void
|
||||
((k : Integer 0 (+ k 1)))
|
||||
((k : Natural 0 (+ k 1)))
|
||||
((> k kk))
|
||||
(set! index (+ i (* *d* (+ j (* *d* k)))))
|
||||
(vector-set! (vector-ref *p* *iii*) index #t))))
|
||||
|
|
@ -178,8 +178,8 @@
|
|||
(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))
|
||||
(let: ((m : Natural (+ (* *d* (+ *d* 1)) 1))
|
||||
(n : Natural 0))
|
||||
(cond ((fit 0 m) (set! n (place 0 m)))
|
||||
(else (begin (newline) (display "Error."))))
|
||||
(cond ((trial n)
|
||||
|
|
@ -192,8 +192,8 @@
|
|||
|
||||
;;; call: (start)
|
||||
|
||||
(time (let: loop : Void ((n : Integer 50) (v : Void (void)))
|
||||
(time (let: loop : Void ((n : Natural 50) (v : Void (void)))
|
||||
(if (zero? n)
|
||||
v
|
||||
(loop (- n 1)
|
||||
(loop (sub1 n)
|
||||
(start)))))
|
||||
|
|
|
|||
|
|
@ -13,28 +13,28 @@
|
|||
|
||||
;;; TRIANG -- Board game benchmark.
|
||||
|
||||
(: *board* (Vectorof Integer))
|
||||
(: *board* (Vectorof Natural))
|
||||
(define *board* (make-vector 16 1))
|
||||
(: *sequence* (Vectorof Integer))
|
||||
(: *sequence* (Vectorof Natural))
|
||||
(define *sequence* (make-vector 14 0))
|
||||
(: *a* (Vectorof Integer))
|
||||
(: *a* (Vectorof Natural))
|
||||
(define *a* (make-vector 37))
|
||||
(: *b* (Vectorof Integer))
|
||||
(: *b* (Vectorof Natural))
|
||||
(define *b* (make-vector 37))
|
||||
(: *c* (Vectorof Integer))
|
||||
(: *c* (Vectorof Natural))
|
||||
(define *c* (make-vector 37))
|
||||
(: *answer* (Listof (Listof Integer)))
|
||||
(: *answer* (Listof (Listof Natural)))
|
||||
(define *answer* '())
|
||||
(: *final* (Listof Integer))
|
||||
(: *final* (Listof Natural))
|
||||
(define *final* '())
|
||||
|
||||
(: last-position ( -> Integer))
|
||||
(: last-position ( -> Natural))
|
||||
(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))
|
||||
(: ttry (Natural Natural -> Any))
|
||||
(define (ttry i depth)
|
||||
(cond ((= depth 14)
|
||||
(let ((lp (last-position)))
|
||||
|
|
@ -59,27 +59,27 @@
|
|||
(vector-set! *board* (vector-ref *c* i) 0) '())
|
||||
(else #f)))
|
||||
|
||||
(: gogogo (Integer -> Any))
|
||||
(: gogogo (Natural -> Any))
|
||||
(define (gogogo i)
|
||||
(let ((*answer* '())
|
||||
(*final* '()))
|
||||
(ttry i 1)))
|
||||
|
||||
(for-each (lambda: ((i : Integer) (x : Integer)) (vector-set! *a* i x))
|
||||
(for-each (lambda: ((i : Natural) (x : Natural)) (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))
|
||||
(for-each (lambda: ((i : Natural) (x : Natural)) (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))
|
||||
(for-each (lambda: ((i : Natural) (x : Natural)) (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
|
||||
|
|
@ -89,9 +89,9 @@
|
|||
|
||||
;;; call: (gogogo 22))
|
||||
|
||||
(time (let: loop : 'done ((n : Integer 1000000))
|
||||
(time (let: loop : 'done ((n : Natural 1000000))
|
||||
(if (zero? n)
|
||||
'done
|
||||
(begin
|
||||
(gogogo 22)
|
||||
(loop (- n 1))))))
|
||||
(loop (sub1 n))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user