Created
August 22, 2013 04:36
-
-
Save SaitoAtsushi/6303266 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Index: bench | |
| =================================================================== | |
| --- bench (リビジョン 6659) | |
| +++ bench (作業コピー) | |
| @@ -44,13 +44,13 @@ | |
| KVW_BENCHMARKS="ack array1 string sum1 cat cat2 cat3 tail wc" | |
| -IO_BENCHMARKS="read0 read1 read2 read3" | |
| +IO_BENCHMARKS="read1 read2 read3" | |
| OTHER_BENCHMARKS="bibfreq bibfreq2 compiler conform dynamic earley graphs lattice matrix maze mazefun nqueens paraffins parsing peval pi primes quicksort ray scheme simplex slatex" | |
| GC_BENCHMARKS="nboyer sboyer gcbench mperm" | |
| -SYNTH_BENCHMARKS="equal normalization bv2string listsort vecsort hashtable0" | |
| +SYNTH_BENCHMARKS="equal listsort vecsort hashtable0" | |
| ALL_BENCHMARKS="$GABRIEL_BENCHMARKS $NUM_BENCHMARKS $KVW_BENCHMARKS $IO_BENCHMARKS $OTHER_BENCHMARKS $GC_BENCHMARKS $SYNTH_BENCHMARKS" | |
| @@ -66,37 +66,7 @@ | |
| setup () | |
| { | |
| - case ${OSNAME} in | |
| - | |
| - "SunOS") | |
| - | |
| - APPS="/proj/will/Apps" | |
| - | |
| - ;; | |
| - | |
| - "Linux") | |
| - | |
| - APPS="/usr/local" | |
| - | |
| - IKARUS="${APPS}/bin/ikarus" | |
| - HENCHMAN="/home/henchman/bin/larceny" | |
| - ;; | |
| - | |
| - "Darwin") | |
| - | |
| - IKARUS=${IKARUS:-"ikarus"} | |
| - ;; | |
| - | |
| - esac | |
| - | |
| - # For both Solaris and Linux machines. | |
| - | |
| - LARCENY=${LARCENY:-"../../../larceny"} | |
| - PETIT=${PETIT:-"../../../petit-larceny"} | |
| - PLTR6RS=${PLTR6RS:-"plt-r6rs"} | |
| - YPSILON=${YPSILON:-"ypsilon"} | |
| - MOSH=${MOSH:-"mosh"} | |
| - PETITE=${PETITE:-"petite"} | |
| + GOSH=${GOSH:-"gosh"} | |
| } | |
| @@ -108,19 +78,9 @@ | |
| { | |
| echo $1 | |
| echo ' | |
| -Usage: bench [-r runs] <system> <benchmark> | |
| +Usage: bench [-r runs] <benchmark> | |
| -<system> is the abbreviated name of the implementation to benchmark: | |
| - ikarus for Ikarus | |
| - larceny for Larceny | |
| - mosh for Mosh | |
| - petit for Petit Larceny | |
| - petite for Petite Chez | |
| - plt for PLT Scheme | |
| - ypsilon for Ypsilon | |
| - all for all of the above | |
| - | |
| <benchmark> is the name of the benchmark(s) to run: | |
| all for all of the usual benchmarks | |
| @@ -161,139 +121,41 @@ | |
| { | |
| echo | |
| echo Testing $1 under ${NAME} | |
| - make_src_code $1 | |
| - echo Compiling... | |
| - $COMP "${TEMP}/$1.${EXTENSION}" | |
| i=0 | |
| while [ "$i" -lt "$NB_RUNS" ] | |
| do | |
| echo Running... | |
| - $EXEC "${TEMP}/$1.${EXTENSIONCOMP}" "${INPUTS}/$1.input" | |
| + $EXEC "${SRC}/$1.sch" "${INPUTS}/$1.input" | |
| i=`expr $i + 1` | |
| done | |
| } 2>&1 | tee -a results.${NAME} | |
| } | |
| -make_src_code () | |
| -{ | |
| - cat "${SRC}/$1.sch" "${SRC}/common.sch" > "${TEMP}/$1.${EXTENSION}" | |
| -} | |
| # ----------------------------------------------------------------------------- | |
| -# Definitions specific to Larceny and Petit Larceny | |
| +# Definitions specific to Sagittarius Scheme | |
| # | |
| # The --nocontract command-line option reduces variability | |
| # of timing, and probably corresponds to the default for | |
| # most other systems. | |
| -larceny_comp () | |
| -{ | |
| - echo "(import (larceny compiler)) (compile-file \"$1\")" \ | |
| -| time "${LARCENY}" -err5rs -- -e "(repl-prompt values)" | |
| -} | |
| -larceny_exec () | |
| +gosh_exec () | |
| { | |
| - time "${LARCENY}" --nocontract --r6rs --program "$1" < "$2" | |
| + time "${GOSH}" -I"${SRC}" "$1" < "$2" | |
| } | |
| -petit_comp () | |
| -{ | |
| - echo "(import (larceny compiler)) (compile-file \"$1\")" \ | |
| - | time "${PETIT}" -err5rs -- -e "(repl-prompt values)" | |
| -} | |
| -petit_exec () | |
| -{ | |
| - time "${PETIT}" --nocontract --r6rs --program "$1" < "$2" | |
| -} | |
| - | |
| -henchman_comp () | |
| -{ | |
| - echo "(import (larceny compiler)) (compile-file \"$1\")" \ | |
| - | time "${HENCHMAN}" -err5rs -- -e "(repl-prompt values)" | |
| -} | |
| - | |
| -henchman_exec () | |
| -{ | |
| - time "${HENCHMAN}" --nocontract --r6rs --program "$1" < "$2" | |
| -} | |
| - | |
| # ----------------------------------------------------------------------------- | |
| -# Definitions specific to Ikarus | |
| -ikarus_comp () | |
| -{ | |
| - : | |
| -} | |
| - | |
| -ikarus_exec () | |
| -{ | |
| - time "${IKARUS}" --r6rs-script "$1" < "$2" | |
| -} | |
| - | |
| -# ----------------------------------------------------------------------------- | |
| -# Definitions specific to PLT Scheme | |
| - | |
| -plt_comp () | |
| -{ | |
| - echo | time "${PLTR6RS}" --compile "$1" | |
| -} | |
| - | |
| -plt_exec () | |
| -{ | |
| - time "${PLTR6RS}" "$1" < "$2" | |
| -} | |
| - | |
| -# ----------------------------------------------------------------------------- | |
| -# Definitions specific to Ypsilon | |
| - | |
| -ypsilon_comp () | |
| -{ | |
| - : | |
| -} | |
| - | |
| -ypsilon_exec () | |
| -{ | |
| - time "${YPSILON}" "$1" < "$2" | |
| -} | |
| - | |
| -# ----------------------------------------------------------------------------- | |
| -# Definitions specific to Mosh | |
| - | |
| -mosh_comp () | |
| -{ | |
| - : | |
| -} | |
| - | |
| -mosh_exec () | |
| -{ | |
| - time "${MOSH}" "$1" < "$2" | |
| -} | |
| - | |
| -# ----------------------------------------------------------------------------- | |
| -# Definitions specific to Petite Chez | |
| - | |
| -petite_comp () | |
| -{ | |
| - : | |
| -} | |
| - | |
| -petite_exec () | |
| -{ | |
| - time "${PETITE}" --optimize-level 2 --program "$1" < "$2" | |
| -} | |
| - | |
| -# ----------------------------------------------------------------------------- | |
| - | |
| ## Arg processing... | |
| -if [ "$#" -lt 2 ]; then | |
| - error '>>> At least two command line arguments are needed' | |
| +if [ "$#" -lt 1 ]; then | |
| + error '>>> At least one command line arguments are needed' | |
| fi | |
| -while [ $# -gt 2 ] ; do | |
| +while [ $# -gt 1 ] ; do | |
| arg="$1" | |
| shift | |
| case $arg in | |
| @@ -304,16 +166,12 @@ | |
| esac | |
| done | |
| -if [ "$#" -ne 2 ]; then | |
| - error '>>> Last two arguments must be <system> and <benchmark>' | |
| +if [ "$#" -ne 1 ]; then | |
| + error '>>> Last a argument must be <benchmark>' | |
| fi | |
| -case "$1" in | |
| - all) systems="$ALL_SYSTEMS" ;; | |
| - *) systems="$1" ;; | |
| -esac | |
| -case "$2" in | |
| +case "$1" in | |
| all) benchmarks="$ALL_BENCHMARKS" ;; | |
| gabriel) benchmarks="$GABRIEL_BENCHMARKS" ;; | |
| kvw) benchmarks="$KVW_BENCHMARKS" ;; | |
| @@ -321,105 +179,21 @@ | |
| awk) benchmarks="$AWK_BENCHMARKS" ;; | |
| c) benchmarks="$C_BENCHMARKS" ;; | |
| java) benchmarks="$JAVA_BENCHMARKS" ;; | |
| - *) benchmarks="$2" ;; | |
| + *) benchmarks="$1" ;; | |
| esac | |
| -## Run each benchmark under each system... | |
| -for system in $systems ; do | |
| - case "$system" in | |
| +NAME='Gauche' | |
| +EXEC=gosh_exec | |
| +EXTENSION="sch" | |
| +EXECCOMMANDS="" | |
| - larceny) NAME='Larceny' | |
| - COMP=larceny_comp | |
| - EXEC=larceny_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="slfasl" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - petit) NAME='PetitLarceny' | |
| - COMP=petit_comp | |
| - EXEC=petit_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="slfasl" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - henchman) NAME='Henchman' | |
| - COMP=henchman_comp | |
| - EXEC=henchman_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="slfasl" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - ikarus) NAME='Ikarus' | |
| - COMP=ikarus_comp | |
| - EXEC=ikarus_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="sch" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - plt) NAME='PLT' | |
| - COMP=plt_comp | |
| - EXEC=plt_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="sch" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - ypsilon) NAME='Ypsilon' # copied from Ikarus' settings... | |
| - COMP=ypsilon_comp | |
| - EXEC=ypsilon_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="sch" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - mosh) NAME='Mosh' | |
| - COMP=mosh_comp | |
| - EXEC=mosh_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="sch" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - petite) NAME='Petite' | |
| - COMP=petite_comp | |
| - EXEC=petite_exec | |
| - COMPOPTS="" | |
| - EXTENSION="sch" | |
| - EXTENSIONCOMP="sch" | |
| - COMPCOMMANDS="" | |
| - EXECCOMMANDS="" | |
| - ;; | |
| - | |
| - esac | |
| - | |
| { | |
| echo | |
| echo '****************************' | |
| echo Benchmarking ${NAME} on `date` under `uname -a` | |
| } >> results.${NAME} | |
| - mkdir "${TEMP}" | |
| - | |
| for program in $benchmarks ; do | |
| evaluate $program | |
| done | |
| -done | |
| Index: inputs/browse.input | |
| =================================================================== | |
| --- inputs/browse.input (リビジョン 6659) | |
| +++ inputs/browse.input (作業コピー) | |
| @@ -3,16 +3,16 @@ | |
| (*a *b *b *a (*a) (*b)) | |
| (? ? * (b a) * ? ?)) | |
| -(\x38;37 \x31;77 \x31;090 \x36;17 \x36;61 \x37;49 \x36;28 \x35;6 | |
| - \x38;26 \x34;08 \x31;035 \x34;74 \x33;20 \x34;52 \x36;72 \x39;91 | |
| - \x31;55 \x31;22 \x37;93 \x32;21 \x37;16 \x37;27 \x38;48 \x33;09 | |
| - \x31;44 \x39;36 \x31;00 \x38;81 \x32;87 \x34;30 \x32;3 \x37;71 | |
| - \x32;32 \x38;04 \x39;58 \x36;50 \x31;068 \x31;057 \x34;63 \x32;76 | |
| - \x31;046 \x31;002 \x31;99 \x33;4 \x37;38 \x32;10 \x35;40 \x33;97 | |
| - \x33;42 \x33;64 \x37;82 \x36;83 \x38;9 \x33;75 \x31;66 \x35;95 | |
| - \x38;92 \x37;05 \x35;07 \x36;39 \x33;31 \x31;88 \x32;43 \x34;41 | |
| - \x31;013 \x31;079 \x36;7 \x32;98 \x33;86 \x35;73 \x38;59 \x31;33 | |
| - \x37;60 \x31;2 \x35;29 \x38;15 \x31;11 \x34;96 \x34;5 \x32;65 | |
| - \x39;25 \x39;03 \x32;54 \x37;8 \x35;51 \x36;06 \x34;85 \x35;18 | |
| - \x34;19 \x38;70 \x35;62 \x31; \x33;53 \x39;80 \x36;94 \x39;14 | |
| - \x39;69 \x39;47 \x35;84 \x31;024) | |
| +(|\x38;37| |\x31;77| |\x31;090| |\x36;17| |\x36;61| |\x37;49| |\x36;28| |\x35;6| | |
| + |\x38;26| |\x34;08| |\x31;035| |\x34;74| |\x33;20| |\x34;52| |\x36;72| |\x39;91| | |
| + |\x31;55| |\x31;22| |\x37;93| |\x32;21| |\x37;16| |\x37;27| |\x38;48| |\x33;09| | |
| + |\x31;44| |\x39;36| |\x31;00| |\x38;81| |\x32;87| |\x34;30| |\x32;3| |\x37;71| | |
| + |\x32;32| |\x38;04| |\x39;58| |\x36;50| |\x31;068| |\x31;057| |\x34;63| |\x32;76| | |
| + |\x31;046| |\x31;002| |\x31;99| |\x33;4| |\x37;38| |\x32;10| |\x35;40| |\x33;97| | |
| + |\x33;42| |\x33;64| |\x37;82| |\x36;83| |\x38;9| |\x33;75| |\x31;66| |\x35;95| | |
| + |\x38;92| |\x37;05| |\x35;07| |\x36;39| |\x33;31| |\x31;88| |\x32;43| |\x34;41| | |
| + |\x31;013| |\x31;079| |\x36;7| |\x32;98| |\x33;86| |\x35;73| |\x38;59| |\x31;33| | |
| + |\x37;60| |\x31;2| |\x35;29| |\x38;15| |\x31;11| |\x34;96| |\x34;5| |\x32;65| | |
| + |\x39;25| |\x39;03| |\x32;54| |\x37;8| |\x35;51| |\x36;06| |\x34;85| |\x35;18| | |
| + |\x34;19| |\x38;70| |\x35;62| |\x31;| |\x33;53| |\x39;80| |\x36;94| |\x39;14| | |
| + |\x39;69| |\x39;47| |\x35;84| |\x31;024|) | |
| \ No newline at end of file | |
| Index: inputs/wc.input | |
| =================================================================== | |
| --- inputs/wc.input (リビジョン 6659) | |
| +++ inputs/wc.input (作業コピー) | |
| @@ -1,3 +1,3 @@ | |
| 25 | |
| "inputs/bib" | |
| -(31102 851820 4460056) | |
| +(31102 851820 4491158) | |
| Index: src/parsing.sch | |
| =================================================================== | |
| --- src/parsing.sch (リビジョン 6659) | |
| +++ src/parsing.sch (作業コピー) | |
| @@ -29,14 +29,9 @@ | |
| ; n defaults to 1000, and input defaults to "nboyer.sch". | |
| ; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| - | |
| -(import (rnrs base) | |
| - (rnrs unicode) | |
| - (rnrs lists) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs mutable-strings)) | |
| +(use common) | |
| + | |
| (define (parsing-benchmark . rest) | |
| (let* ((n (if (null? rest) 1000 (car rest))) | |
| (input (if (or (null? rest) (null? (cdr rest))) | |
| @@ -928,7 +923,7 @@ | |
| ((eq? x 'eof) | |
| y)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/scheme.sch | |
| =================================================================== | |
| --- src/scheme.sch (リビジョン 6659) | |
| +++ src/scheme.sch (作業コピー) | |
| @@ -2,12 +2,7 @@ | |
| ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| -(import (rnrs base) | |
| - (rnrs unicode) | |
| - (rnrs lists) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs) | |
| - (rnrs mutable-strings)) | |
| +(use common) | |
| (define (scheme-eval expr) | |
| (let ((code (scheme-comp expr scheme-global-environment))) | |
| @@ -1042,7 +1037,7 @@ | |
| (def-proc 'newline newline) | |
| (def-proc 'write-char write-char) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/sum.sch | |
| =================================================================== | |
| --- src/sum.sch (リビジョン 6659) | |
| +++ src/sum.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; SUM -- Compute sum of integers from 0 to 10000 | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (run n) | |
| (let loop ((i n) (sum 0)) | |
| @@ -9,7 +8,7 @@ | |
| sum | |
| (loop (- i 1) (+ i sum))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/string.sch | |
| =================================================================== | |
| --- src/string.sch (リビジョン 6659) | |
| +++ src/string.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; STRING -- One of the Kernighan and Van Wyk benchmarks. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define s "abcdef") | |
| @@ -24,7 +22,7 @@ | |
| (set! s "abcdef") | |
| (trial n))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/wc.sch | |
| =================================================================== | |
| --- src/wc.sch (リビジョン 6659) | |
| +++ src/wc.sch (作業コピー) | |
| @@ -1,9 +1,7 @@ | |
| ;;; WC -- One of the Kernighan and Van Wyk benchmarks. | |
| ;;; Rewritten by Will Clinger into more idiomatic (and correct!) Scheme. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (wcport port) | |
| (define (loop nl nw nc inword?) | |
| @@ -21,7 +19,7 @@ | |
| (define (go x) | |
| (call-with-input-file x wcport)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input (read)) | |
| (output (read)) | |
| Index: src/destruc.sch | |
| =================================================================== | |
| --- src/destruc.sch (リビジョン 6659) | |
| +++ src/destruc.sch (作業コピー) | |
| @@ -1,9 +1,6 @@ | |
| ;;; DESTRUC -- Destructive operation benchmark. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| (define (append-to-tail! x y) | |
| (if (null? x) | |
| @@ -46,7 +43,7 @@ | |
| x)) | |
| (set-car! a i)))))))))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/ntakl.sch | |
| =================================================================== | |
| --- src/ntakl.sch (リビジョン 6659) | |
| +++ src/ntakl.sch (作業コピー) | |
| @@ -1,8 +1,7 @@ | |
| ;;; NTAKL -- The TAKeuchi function using lists as counters, | |
| ;;; with an alternative boolean expression. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (listn n) | |
| (if (= n 0) | |
| @@ -40,7 +39,7 @@ | |
| (else | |
| (shorterp (cdr x) (cdr y))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/listsort.sch | |
| =================================================================== | |
| --- src/listsort.sch (リビジョン 6659) | |
| +++ src/listsort.sch (作業コピー) | |
| @@ -17,22 +17,19 @@ | |
| ; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs sorting) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic fixnums)) | |
| +(use common) | |
| +(use srfi-60) | |
| ; Returns a list of all Unicode characters from lo to hi, | |
| ; inclusive. | |
| (define (all-characters lo hi) | |
| (define (loop sv0 sv1 chars) | |
| - (cond ((fx<? sv1 sv0) | |
| + (cond ((< sv1 sv0) | |
| chars) | |
| - ((or (fx<? sv1 #xd800) | |
| - (fx<? #xdfff sv1)) | |
| - (loop sv0 (fx- sv1 1) (cons (integer->char sv1) chars))) | |
| + ((or (< sv1 #xd800) | |
| + (< #xdfff sv1)) | |
| + (loop sv0 (- sv1 1) (cons (integer->char sv1) chars))) | |
| (else | |
| (loop sv0 #xd7ff chars)))) | |
| (loop (char->integer lo) (char->integer hi) '())) | |
| @@ -40,14 +37,13 @@ | |
| (define (hash<? c0 c1) | |
| (define (hash c) | |
| (let ((sv (char->integer c))) | |
| - (fx- sv (fxxor sv (fxarithmetic-shift-right sv 2))))) | |
| - (fx<? (hash c0) (hash c1))) | |
| + (- sv (bitwise-xor sv (ash sv -2))))) | |
| + (< (hash c0) (hash c1))) | |
| (define (hash-then-sort chars) | |
| - (list-sort char<? | |
| - (list-sort hash<? chars))) | |
| + (sort (sort chars hash<?) char<?)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/mbrot.sch | |
| =================================================================== | |
| --- src/mbrot.sch (リビジョン 6659) | |
| +++ src/mbrot.sch (作業コピー) | |
| @@ -1,28 +1,26 @@ | |
| ;;; MBROT -- Generation of Mandelbrot set fractal. | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (count r i step x y) | |
| (let ((max-count 64) | |
| (radius^2 16.0)) | |
| - (let ((cr (fl+ r (fl* (inexact x) step))) | |
| - (ci (fl+ i (fl* (inexact y) step)))) | |
| + (let ((cr (+ r (* (inexact x) step))) | |
| + (ci (+ i (* (inexact y) step)))) | |
| (let loop ((zr cr) | |
| (zi ci) | |
| (c 0)) | |
| (if (= c max-count) | |
| c | |
| - (let ((zr^2 (fl* zr zr)) | |
| - (zi^2 (fl* zi zi))) | |
| - (if (fl>? (fl+ zr^2 zi^2) radius^2) | |
| + (let ((zr^2 (* zr zr)) | |
| + (zi^2 (* zi zi))) | |
| + (if (> (+ zr^2 zi^2) radius^2) | |
| c | |
| - (let ((new-zr (fl+ (fl- zr^2 zi^2) cr)) | |
| - (new-zi (fl+ (fl* 2.0 (fl* zr zi)) ci))) | |
| + (let ((new-zr (+ (- zr^2 zi^2) cr)) | |
| + (new-zi (+ (* 2.0 (* zr zi)) ci))) | |
| (loop new-zr new-zi (+ c 1)))))))))) | |
| (define (mbrot matrix r i step n) | |
| @@ -45,7 +43,7 @@ | |
| (mbrot matrix -1.0 -0.5 0.005 n) | |
| (vector-ref (vector-ref matrix 0) 0))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/graphs.sch | |
| =================================================================== | |
| --- src/graphs.sch (リビジョン 6659) | |
| +++ src/graphs.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; GRAPHS -- Obtained from Andrew Wright. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ;;; ==== util.ss ==== | |
| @@ -599,7 +597,7 @@ | |
| cons | |
| '())) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/dynamic.sch | |
| =================================================================== | |
| --- src/dynamic.sch (リビジョン 6659) | |
| +++ src/dynamic.sch (作業コピー) | |
| @@ -1,8 +1,8 @@ | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| +(define (keyword->symbol e) | |
| + (string->symbol (string-append ":" (keyword->string e)))) | |
| + | |
| ;;; DYNAMIC -- Obtained from Andrew Wright. | |
| ;; Fritz's dynamic type inferencer, set up to run on itself | |
| @@ -126,6 +126,8 @@ | |
| (dynamic-parse-action-string-const e)) | |
| ((symbol? e) | |
| (dynamic-parse-action-symbol-const e)) | |
| + ((keyword? e) | |
| + (dynamic-parse-action-symbol-const (keyword->symbol e))) | |
| ((vector? e) | |
| (dynamic-parse-action-vector-const (map dynamic-parse-datum (vector->list e)))) | |
| ((pair? e) | |
| @@ -2317,7 +2319,7 @@ | |
| (tag-ast*-show foo) | |
| (counters-show)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/vecsort.sch | |
| =================================================================== | |
| --- src/vecsort.sch (リビジョン 6659) | |
| +++ src/vecsort.sch (作業コピー) | |
| @@ -17,22 +17,19 @@ | |
| ; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs sorting) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic fixnums)) | |
| +(use common) | |
| +(use srfi-60) | |
| ; Returns a vector of all Unicode characters from lo to hi, | |
| ; inclusive. | |
| (define (all-characters lo hi) | |
| (define (loop sv0 sv1 chars) | |
| - (cond ((fx<? sv1 sv0) | |
| + (cond ((< sv1 sv0) | |
| chars) | |
| - ((or (fx<? sv1 #xd800) | |
| - (fx<? #xdfff sv1)) | |
| - (loop sv0 (fx- sv1 1) (cons (integer->char sv1) chars))) | |
| + ((or (< sv1 #xd800) | |
| + (< #xdfff sv1)) | |
| + (loop sv0 (- sv1 1) (cons (integer->char sv1) chars))) | |
| (else | |
| (loop sv0 #xd7ff chars)))) | |
| (list->vector (loop (char->integer lo) (char->integer hi) '()))) | |
| @@ -40,14 +37,13 @@ | |
| (define (hash<? c0 c1) | |
| (define (hash c) | |
| (let ((sv (char->integer c))) | |
| - (fx- sv (fxxor sv (fxarithmetic-shift-right sv 2))))) | |
| - (fx<? (hash c0) (hash c1))) | |
| + (- sv (bitwise-xor sv (arithmetic-shift sv -2))))) | |
| + (< (hash c0) (hash c1))) | |
| (define (hash-then-sort chars) | |
| - (vector-sort char<? | |
| - (vector-sort hash<? chars))) | |
| + (sort (sort chars hash<?) char<?)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/cat2.sch | |
| =================================================================== | |
| --- src/cat2.sch (リビジョン 6659) | |
| +++ src/cat2.sch (作業コピー) | |
| @@ -2,31 +2,29 @@ | |
| ;;; Rewritten by Will Clinger into more idiomatic Scheme | |
| ;;; and to use UTF-8 transcoding. | |
| -(import (rnrs base) | |
| - (rnrs io ports) | |
| - (rnrs io simple) | |
| - (rnrs files)) | |
| +(use common) | |
| +(use file.util) | |
| +(use gauche.charconv) | |
| (define (catport in out) | |
| - (let ((x (get-char in))) | |
| + (let ((x (read-char in))) | |
| (if (not (eof-object? x)) | |
| (begin | |
| - (put-char out x) | |
| + (write-char x out) | |
| (catport in out))))) | |
| (define (go input-file output-file) | |
| - (let ((t (make-transcoder (utf-8-codec)))) | |
| (if (file-exists? output-file) | |
| - (delete-file output-file)) | |
| + (remove-file output-file)) | |
| (call-with-port | |
| - (open-file-input-port input-file (file-options) 'block t) | |
| + (open-input-file input-file :buffering :full :encoding 'utf-8) | |
| (lambda (in) | |
| (call-with-port | |
| - (open-file-output-port output-file (file-options) 'block t) | |
| + (open-output-file output-file :buffering :full :encoding 'utf-8) | |
| (lambda (out) | |
| - (catport in out))))))) | |
| + (catport in out)))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/cat3.sch | |
| =================================================================== | |
| --- src/cat3.sch (リビジョン 6659) | |
| +++ src/cat3.sch (作業コピー) | |
| @@ -2,31 +2,28 @@ | |
| ;;; Rewritten by Will Clinger into more idiomatic Scheme | |
| ;;; and to use UTF-16 transcoding. | |
| -(import (rnrs base) | |
| - (rnrs io ports) | |
| - (rnrs io simple) | |
| - (rnrs files)) | |
| +(use common) | |
| +(use file.util) | |
| (define (catport in out) | |
| - (let ((x (get-char in))) | |
| + (let ((x (read-char in))) | |
| (if (not (eof-object? x)) | |
| (begin | |
| - (put-char out x) | |
| + (write-char x out) | |
| (catport in out))))) | |
| (define (go input-file output-file) | |
| - (let ((t (make-transcoder (utf-16-codec)))) | |
| (if (file-exists? output-file) | |
| - (delete-file output-file)) | |
| + (remove-file output-file)) | |
| (call-with-port | |
| - (open-file-input-port input-file (file-options) 'block t) | |
| + (open-input-file input-file :buffering :full :encoding 'utf-16) | |
| (lambda (in) | |
| (call-with-port | |
| - (open-file-output-port output-file (file-options) 'block t) | |
| + (open-output-file output-file :buffering :full :encoding 'utf-16) | |
| (lambda (out) | |
| - (catport in out))))))) | |
| + (catport in out)))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/takl.sch | |
| =================================================================== | |
| --- src/takl.sch (リビジョン 6659) | |
| +++ src/takl.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; TAKL -- The TAKeuchi function using lists as counters. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (listn n) | |
| (if (= n 0) | |
| @@ -25,7 +24,7 @@ | |
| (shorterp (cdr x) | |
| (cdr y))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/nboyer.sch | |
| =================================================================== | |
| --- src/nboyer.sch (リビジョン 6659) | |
| +++ src/nboyer.sch (作業コピー) | |
| @@ -55,12 +55,9 @@ | |
| ; The second phase creates the test problem, and tests to see | |
| ; whether it is implied by the lemmas. | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input (read)) | |
| (output (read)) | |
| Index: src/ack.sch | |
| =================================================================== | |
| --- src/ack.sch (リビジョン 6659) | |
| +++ src/ack.sch (作業コピー) | |
| @@ -1,14 +1,13 @@ | |
| ;;; ACK -- One of the Kernighan and Van Wyk benchmarks. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (ack m n) | |
| (cond ((= m 0) (+ n 1)) | |
| ((= n 0) (ack (- m 1) 1)) | |
| (else (ack (- m 1) (ack m (- n 1)))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/primes.sch | |
| =================================================================== | |
| --- src/primes.sch (リビジョン 6659) | |
| +++ src/primes.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; PRIMES -- Compute primes less than 100, written by Eric Mohr. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (interval-list m n) | |
| (if (> m n) | |
| @@ -25,7 +24,7 @@ | |
| (define (primes<= n) | |
| (sieve (interval-list 2 n))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/fib.sch | |
| =================================================================== | |
| --- src/fib.sch (リビジョン 6659) | |
| +++ src/fib.sch (作業コピー) | |
| @@ -1,6 +1,6 @@ | |
| ;;; FIB -- A classic benchmark, computes fib(n) inefficiently. | |
| -(import (rnrs base) (rnrs io simple)) | |
| +(use common) | |
| (define (fib n) | |
| (if (< n 2) | |
| @@ -8,7 +8,7 @@ | |
| (+ (fib (- n 1)) | |
| (fib (- n 2))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input (read)) | |
| (output (read)) | |
| Index: src/conform.sch | |
| =================================================================== | |
| --- src/conform.sch (リビジョン 6659) | |
| +++ src/conform.sch (作業コピー) | |
| @@ -1,10 +1,6 @@ | |
| ;;; CONFORM -- Type checker, written by Jim Miller. | |
| -(import (rnrs base) | |
| - (rnrs unicode) | |
| - (rnrs lists) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| ;;; Functional and unstable | |
| @@ -456,7 +452,7 @@ | |
| (map name | |
| (graph-nodes (make-lattice (make-graph a b c d any-node none-node) #f)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/fibc.sch | |
| =================================================================== | |
| --- src/fibc.sch (リビジョン 6659) | |
| +++ src/fibc.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; FIBC -- FIB using first-class continuations, written by Kent Dybvig | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (succ n) (+ n 1)) | |
| (define (pred n) (- n 1)) | |
| @@ -24,7 +23,7 @@ | |
| (lambda (c) (fibc (pred (pred x)) c))) | |
| c)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input (read)) | |
| (output (read)) | |
| Index: src/matrix.sch | |
| =================================================================== | |
| --- src/matrix.sch (リビジョン 6659) | |
| +++ src/matrix.sch (作業コピー) | |
| @@ -1,9 +1,6 @@ | |
| ;;; MATRIX -- Obtained from Andrew Wright. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| ; Chez-Scheme compatibility stuff: | |
| @@ -750,7 +747,7 @@ | |
| csize | |
| state)))))))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/mazefun.sch | |
| =================================================================== | |
| --- src/mazefun.sch (リビジョン 6659) | |
| +++ src/mazefun.sch (作業コピー) | |
| @@ -1,9 +1,7 @@ | |
| ;;; MAZEFUN -- Constructs a maze in a purely functional way, | |
| ;;; written by Marc Feeley. | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define foldr | |
| (lambda (f base lst) | |
| @@ -186,7 +184,7 @@ | |
| (list (cons i (+ j 1))) | |
| '()))))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/equal.sch | |
| =================================================================== | |
| --- src/equal.sch (リビジョン 6659) | |
| +++ src/equal.sch (作業コピー) | |
| @@ -18,10 +18,8 @@ | |
| ; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| +(use util.isomorph) | |
| ; Returns a list with n elements, all equal to x. | |
| @@ -72,12 +70,12 @@ | |
| (iterate (- n 1) thunk)) | |
| (else #f))) | |
| -; A simple circular list is a worst case for R5RS equal?. | |
| +; A simple circular list is a worst case for R5RS isomorphic?. | |
| (define (equality-benchmark0 n) | |
| (let ((x (vector->list (make-vector n 'a)))) | |
| (set-cdr! (list-tail x (- n 1)) x) | |
| - (iterate n (hide n (lambda () (equal? x (cdr x))))))) | |
| + (iterate n (hide n (lambda () (isomorphic? x (cdr x))))))) | |
| ; DAG with much sharing. | |
| ; 10 is a good parameter for n. | |
| @@ -85,7 +83,7 @@ | |
| (define (equality-benchmark1 n) | |
| (let ((x (make-test-tree1 n)) | |
| (y (make-test-tree1 n))) | |
| - (iterate n (hide n (lambda () (equal? x y)))))) | |
| + (iterate n (hide n (lambda () (isomorphic? x y)))))) | |
| ; Tree with no sharing. | |
| ; 8 is a good parameter for n. | |
| @@ -93,7 +91,7 @@ | |
| (define (equality-benchmark2 n) | |
| (let ((x (make-test-tree2 n)) | |
| (y (make-test-tree2 n))) | |
| - (iterate n (hide n (lambda () (equal? x y)))))) | |
| + (iterate n (hide n (lambda () (isomorphic? x y)))))) | |
| ; Flat vectors. | |
| ; 1000 might be a good parameter for n. | |
| @@ -101,7 +99,7 @@ | |
| (define (equality-benchmark3 n) | |
| (let* ((x (make-vector n 'a)) | |
| (y (make-vector n 'a))) | |
| - (iterate n (hide n (lambda () (equal? x y)))))) | |
| + (iterate n (hide n (lambda () (isomorphic? x y)))))) | |
| ; Shallow lists. | |
| ; 300 might be a good parameter for n. | |
| @@ -109,7 +107,7 @@ | |
| (define (equality-benchmark4 n) | |
| (let* ((x (vector->list (make-vector n (make-test-tree2 3)))) | |
| (y (vector->list (make-vector n (make-test-tree2 3))))) | |
| - (iterate n (hide n (lambda () (equal? x y)))))) | |
| + (iterate n (hide n (lambda () (isomorphic? x y)))))) | |
| ; No sharing, no proper lists, | |
| ; and deep following car chains instead of cdr. | |
| @@ -118,7 +116,7 @@ | |
| (let* ((x (make-test-tree5 n)) | |
| (y (make-test-tree5 n)) | |
| (iterations (if (null? rest) n (car rest)))) | |
| - (iterate iterations (hide n (lambda () (equal? x y)))))) | |
| + (iterate iterations (hide n (lambda () (isomorphic? x y)))))) | |
| ; A shorter form of the benchmark above. | |
| @@ -133,7 +131,7 @@ | |
| (equality-benchmark4 n4) | |
| (equality-benchmark5 n5))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((input0 (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/pi.sch | |
| =================================================================== | |
| --- src/pi.sch (リビジョン 6659) | |
| +++ src/pi.sch (作業コピー) | |
| @@ -2,8 +2,7 @@ | |
| ; See http://mathworld.wolfram.com/Pi.html for the various algorithms. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ; Utilities. | |
| @@ -114,7 +113,7 @@ | |
| (cons (list b2 (- bs b2) (- b4 b2)) | |
| (pies (+ n s) m s))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/compiler.sch | |
| =================================================================== | |
| --- src/compiler.sch (リビジョン 6659) | |
| +++ src/compiler.sch (作業コピー) | |
| @@ -1,7 +1,8 @@ | |
| ;(define integer->char ascii->char) | |
| ;(define char->integer char->ascii) | |
| -(import (rnrs) (rnrs mutable-pairs) (rnrs mutable-strings)) | |
| +(use common) | |
| +(use srfi-60) | |
| (define open-input-file* open-input-file) | |
| (define (pp-expression expr port) (write expr port) (newline port)) | |
| @@ -11136,7 +11137,7 @@ | |
| (put-target targ)) | |
| )) ; dummy3 | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/bibfreq.sch | |
| =================================================================== | |
| --- src/bibfreq.sch (リビジョン 6659) | |
| +++ src/bibfreq.sch (作業コピー) | |
| @@ -2,16 +2,12 @@ | |
| ;;; aziz ghuloum (Nov 2007) | |
| ;;; modified (slightly) by Will Clinger (Nov 2007) | |
| -(import (rnrs base) | |
| - (rnrs unicode) | |
| - (rnrs sorting) | |
| - (rnrs hashtables) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (fill input-file h) | |
| (let ((p (open-input-file input-file))) | |
| (define (put ls) | |
| - (hashtable-update! h | |
| + (hash-table-update! h | |
| (string->symbol | |
| (list->string | |
| (reverse ls))) | |
| @@ -41,17 +37,14 @@ | |
| (else (cons (car ls) (list-head (cdr ls) (- n 1)))))) | |
| (define (go input-file) | |
| - (let ((h (make-eq-hashtable))) | |
| + (let ((h (make-hash-table 'eq?))) | |
| (fill input-file h) | |
| - (let-values (((keys vals) (hashtable-entries h))) | |
| - (let ((ls (map cons | |
| - (vector->list keys) | |
| - (vector->list vals)))) | |
| - (list-head | |
| - (list-sort (lambda (a b) (> (cdr a) (cdr b))) ls) | |
| - 10))))) | |
| + (let ((ls (hash-table->alist h))) | |
| + (take | |
| + (sort ls (lambda (a b) (> (cdr a) (cdr b)))) | |
| + 10)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/hashtable0.sch | |
| =================================================================== | |
| --- src/hashtable0.sch (リビジョン 6659) | |
| +++ src/hashtable0.sch (作業コピー) | |
| @@ -19,10 +19,7 @@ | |
| ; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs hashtables)) | |
| +(use common) | |
| ; Crude test rig, just for benchmarking. | |
| @@ -40,7 +37,7 @@ | |
| (define (hashtable-eq-tests n2 . rest) | |
| (call-with-current-continuation | |
| (lambda (exit) | |
| - (let ((maker (if (null? rest) make-eq-hashtable (car rest))) | |
| + (let ((maker (if (null? rest) (lambda()(make-hash-table 'eq)) (car rest))) | |
| (test (lambda (n passed?) | |
| (if (not passed?) | |
| (report-failure! n))))) | |
| @@ -55,49 +52,46 @@ | |
| ;(n2 10000) ; population added in second phase | |
| (n3 1000)) ; population added in third phase | |
| - (define (hashtable-get t key) | |
| - (hashtable-ref t key #f)) | |
| + (test 1 (eq? not-found (hash-table-get t x1 not-found))) | |
| + (hash-table-put! t x1 'a) | |
| + (test 2 (eq? 'a (hash-table-get t x1))) | |
| + (hash-table-put! t sym1 'b) | |
| + (test 3 (eq? 'a (hash-table-get t x1))) | |
| + (test 4 (eq? 'b (hash-table-get t sym1))) | |
| + (hash-table-put! t vec1 'c) | |
| + (test 5 (eq? 'a (hash-table-get t x1))) | |
| + (test 6 (eq? 'b (hash-table-get t sym1))) | |
| + (test 7 (eq? 'c (hash-table-get t vec1))) | |
| + (hash-table-put! t n2 'd) | |
| + (test 8 (eq? 'a (hash-table-get t x1))) | |
| + (test 9 (eq? 'b (hash-table-get t sym1))) | |
| + (test 10 (eq? 'c (hash-table-get t vec1))) | |
| + (test 11 (eq? 'd (hash-table-get t n2))) | |
| - (test 1 (eq? not-found (hashtable-ref t x1 not-found))) | |
| - (hashtable-set! t x1 'a) | |
| - (test 2 (eq? 'a (hashtable-get t x1))) | |
| - (hashtable-set! t sym1 'b) | |
| - (test 3 (eq? 'a (hashtable-get t x1))) | |
| - (test 4 (eq? 'b (hashtable-get t sym1))) | |
| - (hashtable-set! t vec1 'c) | |
| - (test 5 (eq? 'a (hashtable-get t x1))) | |
| - (test 6 (eq? 'b (hashtable-get t sym1))) | |
| - (test 7 (eq? 'c (hashtable-get t vec1))) | |
| - (hashtable-set! t n2 'd) | |
| - (test 8 (eq? 'a (hashtable-get t x1))) | |
| - (test 9 (eq? 'b (hashtable-get t sym1))) | |
| - (test 10 (eq? 'c (hashtable-get t vec1))) | |
| - (test 11 (eq? 'd (hashtable-get t n2))) | |
| + (hash-table-put! t pair1 'e) | |
| - (hashtable-set! t pair1 'e) | |
| - | |
| (do ((i 0 (+ i 1))) | |
| ((= i n1)) | |
| - (hashtable-set! t (list i) i)) | |
| - (test 12 (eq? 'e (hashtable-get t pair1))) | |
| + (hash-table-put! t (list i) i)) | |
| + (test 12 (eq? 'e (hash-table-get t pair1))) | |
| (do ((i 0 (+ i 1))) | |
| ((= i n2)) | |
| (if (and #f (zero? (mod i 1000))) (display ".")) | |
| - (hashtable-set! t (list i) i)) | |
| - (test 13 (eq? 'e (hashtable-get t pair1))) | |
| + (hash-table-put! t (list i) i)) | |
| + (test 13 (eq? 'e (hash-table-get t pair1))) | |
| (do ((i 0 (+ i 1))) | |
| ((= i n3)) | |
| - (test 14 (eq? 'e (hashtable-get t pair1))) | |
| - (hashtable-set! t (list i) i)) | |
| - (test 15 (eq? 'a (hashtable-get t x1))) | |
| - (test 16 (eq? 'b (hashtable-get t sym1))) | |
| - (test 17 (eq? 'c (hashtable-get t vec1))) | |
| - (test 18 (eq? 'd (hashtable-get t n2))) | |
| - (test 19 (eq? 'e (hashtable-get t pair1))) | |
| + (test 14 (eq? 'e (hash-table-get t pair1))) | |
| + (hash-table-put! t (list i) i)) | |
| + (test 15 (eq? 'a (hash-table-get t x1))) | |
| + (test 16 (eq? 'b (hash-table-get t sym1))) | |
| + (test 17 (eq? 'c (hash-table-get t vec1))) | |
| + (test 18 (eq? 'd (hash-table-get t n2))) | |
| + (test 19 (eq? 'e (hash-table-get t pair1))) | |
| - (hashtable-size t)))))) | |
| + (hash-table-num-entries t)))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| @@ -109,6 +103,6 @@ | |
| (string-append name ":" s1 ":" s2) | |
| count | |
| (lambda () | |
| - (hashtable-eq-tests (hide count input1) make-eq-hashtable) | |
| - (hashtable-eq-tests (hide count input2) make-eqv-hashtable)) | |
| + (hashtable-eq-tests (hide count input1) (^()(make-hash-table 'eq?))) | |
| + (hashtable-eq-tests (hide count input2) (^()(make-hash-table 'eqv?)))) | |
| (lambda (result) (and (null? failures) (equal? result output)))))) | |
| Index: src/divrec.sch | |
| =================================================================== | |
| --- src/divrec.sch (リビジョン 6659) | |
| +++ src/divrec.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; DIVREC -- Benchmark which divides by 2 using lists of n ()'s. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (create-n n) | |
| (do ((n n (- n 1)) | |
| @@ -13,7 +11,7 @@ | |
| (cond ((null? l) '()) | |
| (else (cons (car l) (recursive-div2 (cddr l)))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/tak.sch | |
| =================================================================== | |
| --- src/tak.sch (リビジョン 6659) | |
| +++ src/tak.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; TAK -- A vanilla version of the TAKeuchi function. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (tak x y z) | |
| (if (not (< y x)) | |
| @@ -10,7 +9,7 @@ | |
| (tak (- y 1) z x) | |
| (tak (- z 1) x y)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/pnpoly.sch | |
| =================================================================== | |
| --- src/pnpoly.sch (リビジョン 6659) | |
| +++ src/pnpoly.sch (作業コピー) | |
| @@ -1,24 +1,22 @@ | |
| ;;; PNPOLY - Test if a point is contained in a 2D polygon. | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (pt-in-poly2 xp yp x y) | |
| (let loop ((c #f) (i (- (vector-length xp) 1)) (j 0)) | |
| (if (< i 0) | |
| c | |
| - (if (or (and (or (fl>? (vector-ref yp i) y) | |
| - (fl>=? y (vector-ref yp j))) | |
| - (or (fl>? (vector-ref yp j) y) | |
| - (fl>=? y (vector-ref yp i)))) | |
| - (fl>=? x | |
| - (fl+ (vector-ref xp i) | |
| - (fl/ (fl* | |
| - (fl- (vector-ref xp j) | |
| + (if (or (and (or (> (vector-ref yp i) y) | |
| + (>= y (vector-ref yp j))) | |
| + (or (> (vector-ref yp j) y) | |
| + (>= y (vector-ref yp i)))) | |
| + (>= x | |
| + (+ (vector-ref xp i) | |
| + (/ (* | |
| + (- (vector-ref xp j) | |
| (vector-ref xp i)) | |
| - (fl- y (vector-ref yp i))) | |
| - (fl- (vector-ref yp j) | |
| + (- y (vector-ref yp i))) | |
| + (- (vector-ref yp j) | |
| (vector-ref yp i)))))) | |
| (loop c (- i 1) i) | |
| (loop (not c) (- i 1) i))))) | |
| @@ -41,7 +39,7 @@ | |
| (if (pt-in-poly2 xp yp -.5 -2.5) (set! count (+ count 1))) | |
| count)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/ctak.sch | |
| =================================================================== | |
| --- src/ctak.sch (リビジョン 6659) | |
| +++ src/ctak.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; CTAK -- A version of the TAK procedure that uses continuations. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (ctak x y z) | |
| (call-with-current-continuation | |
| @@ -21,7 +20,7 @@ | |
| (call-with-current-continuation | |
| (lambda (k) (ctak-aux k (- z 1) x y)))))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/nucleic.sch | |
| =================================================================== | |
| --- src/nucleic.sch (リビジョン 6659) | |
| +++ src/nucleic.sch (作業コピー) | |
| @@ -18,9 +18,7 @@ | |
| ; -- MATH UTILITIES ----------------------------------------------------------- | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define-syntax nuc-const | |
| (syntax-rules () | |
| @@ -32,16 +30,16 @@ | |
| (define constant-minus-pi/2 -1.57079632679489661923) | |
| (define (math-atan2 y x) | |
| - (cond ((fl>? x 0.0) | |
| - (flatan (fl/ y x))) | |
| - ((fl<? y 0.0) | |
| - (if (fl=? x 0.0) | |
| + (cond ((> x 0.0) | |
| + (atan (/ y x))) | |
| + ((< y 0.0) | |
| + (if (= x 0.0) | |
| constant-minus-pi/2 | |
| - (fl+ (flatan (fl/ y x)) constant-minus-pi))) | |
| + (+ (atan (/ y x)) constant-minus-pi))) | |
| (else | |
| - (if (fl=? x 0.0) | |
| + (if (= x 0.0) | |
| constant-pi/2 | |
| - (fl+ (flatan (fl/ y x)) constant-pi))))) | |
| + (+ (atan (/ y x)) constant-pi))))) | |
| ; -- POINTS ------------------------------------------------------------------- | |
| @@ -56,22 +54,22 @@ | |
| (define (pt-z-set! pt val) (vector-set! pt 2 val)) | |
| (define (pt-sub p1 p2) | |
| - (make-pt (fl- (pt-x p1) (pt-x p2)) | |
| - (fl- (pt-y p1) (pt-y p2)) | |
| - (fl- (pt-z p1) (pt-z p2)))) | |
| + (make-pt (- (pt-x p1) (pt-x p2)) | |
| + (- (pt-y p1) (pt-y p2)) | |
| + (- (pt-z p1) (pt-z p2)))) | |
| (define (pt-dist p1 p2) | |
| - (let ((dx (fl- (pt-x p1) (pt-x p2))) | |
| - (dy (fl- (pt-y p1) (pt-y p2))) | |
| - (dz (fl- (pt-z p1) (pt-z p2)))) | |
| - (flsqrt (fl+ (fl* dx dx) (fl* dy dy) (fl* dz dz))))) | |
| + (let ((dx (- (pt-x p1) (pt-x p2))) | |
| + (dy (- (pt-y p1) (pt-y p2))) | |
| + (dz (- (pt-z p1) (pt-z p2)))) | |
| + (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))) | |
| (define (pt-phi p) | |
| (let* ((x (pt-x p)) | |
| (y (pt-y p)) | |
| (z (pt-z p)) | |
| (b (math-atan2 x z))) | |
| - (math-atan2 (fl+ (fl* (flcos b) z) (fl* (flsin b) x)) y))) | |
| + (math-atan2 (+ (* (cos b) z) (* (sin b) x)) y))) | |
| (define (pt-theta p) | |
| (math-atan2 (pt-x p) (pt-z p))) | |
| @@ -136,17 +134,17 @@ | |
| (y (pt-y p)) | |
| (z (pt-z p))) | |
| (make-pt | |
| - (fl+ (fl* x (tfo-a tfo)) | |
| - (fl* y (tfo-d tfo)) | |
| - (fl* z (tfo-g tfo)) | |
| + (+ (* x (tfo-a tfo)) | |
| + (* y (tfo-d tfo)) | |
| + (* z (tfo-g tfo)) | |
| (tfo-tx tfo)) | |
| - (fl+ (fl* x (tfo-b tfo)) | |
| - (fl* y (tfo-e tfo)) | |
| - (fl* z (tfo-h tfo)) | |
| + (+ (* x (tfo-b tfo)) | |
| + (* y (tfo-e tfo)) | |
| + (* z (tfo-h tfo)) | |
| (tfo-ty tfo)) | |
| - (fl+ (fl* x (tfo-c tfo)) | |
| - (fl* y (tfo-f tfo)) | |
| - (fl* z (tfo-i tfo)) | |
| + (+ (* x (tfo-c tfo)) | |
| + (* y (tfo-f tfo)) | |
| + (* z (tfo-i tfo)) | |
| (tfo-tz tfo))))) | |
| ; The function "tfo-combine" multiplies two transformation matrices A and B. | |
| @@ -155,44 +153,44 @@ | |
| (define (tfo-combine A B) | |
| (make-tfo | |
| - (fl+ (fl* (tfo-a A) (tfo-a B)) | |
| - (fl* (tfo-b A) (tfo-d B)) | |
| - (fl* (tfo-c A) (tfo-g B))) | |
| - (fl+ (fl* (tfo-a A) (tfo-b B)) | |
| - (fl* (tfo-b A) (tfo-e B)) | |
| - (fl* (tfo-c A) (tfo-h B))) | |
| - (fl+ (fl* (tfo-a A) (tfo-c B)) | |
| - (fl* (tfo-b A) (tfo-f B)) | |
| - (fl* (tfo-c A) (tfo-i B))) | |
| - (fl+ (fl* (tfo-d A) (tfo-a B)) | |
| - (fl* (tfo-e A) (tfo-d B)) | |
| - (fl* (tfo-f A) (tfo-g B))) | |
| - (fl+ (fl* (tfo-d A) (tfo-b B)) | |
| - (fl* (tfo-e A) (tfo-e B)) | |
| - (fl* (tfo-f A) (tfo-h B))) | |
| - (fl+ (fl* (tfo-d A) (tfo-c B)) | |
| - (fl* (tfo-e A) (tfo-f B)) | |
| - (fl* (tfo-f A) (tfo-i B))) | |
| - (fl+ (fl* (tfo-g A) (tfo-a B)) | |
| - (fl* (tfo-h A) (tfo-d B)) | |
| - (fl* (tfo-i A) (tfo-g B))) | |
| - (fl+ (fl* (tfo-g A) (tfo-b B)) | |
| - (fl* (tfo-h A) (tfo-e B)) | |
| - (fl* (tfo-i A) (tfo-h B))) | |
| - (fl+ (fl* (tfo-g A) (tfo-c B)) | |
| - (fl* (tfo-h A) (tfo-f B)) | |
| - (fl* (tfo-i A) (tfo-i B))) | |
| - (fl+ (fl* (tfo-tx A) (tfo-a B)) | |
| - (fl* (tfo-ty A) (tfo-d B)) | |
| - (fl* (tfo-tz A) (tfo-g B)) | |
| + (+ (* (tfo-a A) (tfo-a B)) | |
| + (* (tfo-b A) (tfo-d B)) | |
| + (* (tfo-c A) (tfo-g B))) | |
| + (+ (* (tfo-a A) (tfo-b B)) | |
| + (* (tfo-b A) (tfo-e B)) | |
| + (* (tfo-c A) (tfo-h B))) | |
| + (+ (* (tfo-a A) (tfo-c B)) | |
| + (* (tfo-b A) (tfo-f B)) | |
| + (* (tfo-c A) (tfo-i B))) | |
| + (+ (* (tfo-d A) (tfo-a B)) | |
| + (* (tfo-e A) (tfo-d B)) | |
| + (* (tfo-f A) (tfo-g B))) | |
| + (+ (* (tfo-d A) (tfo-b B)) | |
| + (* (tfo-e A) (tfo-e B)) | |
| + (* (tfo-f A) (tfo-h B))) | |
| + (+ (* (tfo-d A) (tfo-c B)) | |
| + (* (tfo-e A) (tfo-f B)) | |
| + (* (tfo-f A) (tfo-i B))) | |
| + (+ (* (tfo-g A) (tfo-a B)) | |
| + (* (tfo-h A) (tfo-d B)) | |
| + (* (tfo-i A) (tfo-g B))) | |
| + (+ (* (tfo-g A) (tfo-b B)) | |
| + (* (tfo-h A) (tfo-e B)) | |
| + (* (tfo-i A) (tfo-h B))) | |
| + (+ (* (tfo-g A) (tfo-c B)) | |
| + (* (tfo-h A) (tfo-f B)) | |
| + (* (tfo-i A) (tfo-i B))) | |
| + (+ (* (tfo-tx A) (tfo-a B)) | |
| + (* (tfo-ty A) (tfo-d B)) | |
| + (* (tfo-tz A) (tfo-g B)) | |
| (tfo-tx B)) | |
| - (fl+ (fl* (tfo-tx A) (tfo-b B)) | |
| - (fl* (tfo-ty A) (tfo-e B)) | |
| - (fl* (tfo-tz A) (tfo-h B)) | |
| + (+ (* (tfo-tx A) (tfo-b B)) | |
| + (* (tfo-ty A) (tfo-e B)) | |
| + (* (tfo-tz A) (tfo-h B)) | |
| (tfo-ty B)) | |
| - (fl+ (fl* (tfo-tx A) (tfo-c B)) | |
| - (fl* (tfo-ty A) (tfo-f B)) | |
| - (fl* (tfo-tz A) (tfo-i B)) | |
| + (+ (* (tfo-tx A) (tfo-c B)) | |
| + (* (tfo-ty A) (tfo-f B)) | |
| + (* (tfo-tz A) (tfo-i B)) | |
| (tfo-tz B)))) | |
| ; The function "tfo-inv-ortho" computes the inverse of a homogeneous | |
| @@ -206,15 +204,15 @@ | |
| (tfo-a tfo) (tfo-d tfo) (tfo-g tfo) | |
| (tfo-b tfo) (tfo-e tfo) (tfo-h tfo) | |
| (tfo-c tfo) (tfo-f tfo) (tfo-i tfo) | |
| - (fl- (fl+ (fl* (tfo-a tfo) tx) | |
| - (fl* (tfo-b tfo) ty) | |
| - (fl* (tfo-c tfo) tz))) | |
| - (fl- (fl+ (fl* (tfo-d tfo) tx) | |
| - (fl* (tfo-e tfo) ty) | |
| - (fl* (tfo-f tfo) tz))) | |
| - (fl- (fl+ (fl* (tfo-g tfo) tx) | |
| - (fl* (tfo-h tfo) ty) | |
| - (fl* (tfo-i tfo) tz)))))) | |
| + (- (+ (* (tfo-a tfo) tx) | |
| + (* (tfo-b tfo) ty) | |
| + (* (tfo-c tfo) tz))) | |
| + (- (+ (* (tfo-d tfo) tx) | |
| + (* (tfo-e tfo) ty) | |
| + (* (tfo-f tfo) tz))) | |
| + (- (+ (* (tfo-g tfo) tx) | |
| + (* (tfo-h tfo) ty) | |
| + (* (tfo-i tfo) tz)))))) | |
| ; Given three points p1, p2, and p3, the function "tfo-align" computes | |
| ; a transformation matrix such that point p1 gets mapped to (0,0,0), p2 gets | |
| @@ -223,52 +221,52 @@ | |
| (define (tfo-align p1 p2 p3) | |
| (let* ((x1 (pt-x p1)) (y1 (pt-y p1)) (z1 (pt-z p1)) | |
| (x3 (pt-x p3)) (y3 (pt-y p3)) (z3 (pt-z p3)) | |
| - (x31 (fl- x3 x1)) (y31 (fl- y3 y1)) (z31 (fl- z3 z1)) | |
| + (x31 (- x3 x1)) (y31 (- y3 y1)) (z31 (- z3 z1)) | |
| (rotpY (pt-sub p2 p1)) | |
| (Phi (pt-phi rotpY)) | |
| (Theta (pt-theta rotpY)) | |
| - (sinP (flsin Phi)) | |
| - (sinT (flsin Theta)) | |
| - (cosP (flcos Phi)) | |
| - (cosT (flcos Theta)) | |
| - (sinPsinT (fl* sinP sinT)) | |
| - (sinPcosT (fl* sinP cosT)) | |
| - (cosPsinT (fl* cosP sinT)) | |
| - (cosPcosT (fl* cosP cosT)) | |
| + (sinP (sin Phi)) | |
| + (sinT (sin Theta)) | |
| + (cosP (cos Phi)) | |
| + (cosT (cos Theta)) | |
| + (sinPsinT (* sinP sinT)) | |
| + (sinPcosT (* sinP cosT)) | |
| + (cosPsinT (* cosP sinT)) | |
| + (cosPcosT (* cosP cosT)) | |
| (rotpZ | |
| (make-pt | |
| - (fl- (fl* cosT x31) | |
| - (fl* sinT z31)) | |
| - (fl+ (fl* sinPsinT x31) | |
| - (fl* cosP y31) | |
| - (fl* sinPcosT z31)) | |
| - (fl+ (fl* cosPsinT x31) | |
| - (fl- (fl* sinP y31)) | |
| - (fl* cosPcosT z31)))) | |
| + (- (* cosT x31) | |
| + (* sinT z31)) | |
| + (+ (* sinPsinT x31) | |
| + (* cosP y31) | |
| + (* sinPcosT z31)) | |
| + (+ (* cosPsinT x31) | |
| + (- (* sinP y31)) | |
| + (* cosPcosT z31)))) | |
| (Rho (pt-theta rotpZ)) | |
| - (cosR (flcos Rho)) | |
| - (sinR (flsin Rho)) | |
| - (x (fl+ (fl- (fl* x1 cosT)) | |
| - (fl* z1 sinT))) | |
| - (y (fl- (fl- (fl- (fl* x1 sinPsinT)) | |
| - (fl* y1 cosP)) | |
| - (fl* z1 sinPcosT))) | |
| - (z (fl- (fl+ (fl- (fl* x1 cosPsinT)) | |
| - (fl* y1 sinP)) | |
| - (fl* z1 cosPcosT)))) | |
| + (cosR (cos Rho)) | |
| + (sinR (sin Rho)) | |
| + (x (+ (- (* x1 cosT)) | |
| + (* z1 sinT))) | |
| + (y (- (- (- (* x1 sinPsinT)) | |
| + (* y1 cosP)) | |
| + (* z1 sinPcosT))) | |
| + (z (- (+ (- (* x1 cosPsinT)) | |
| + (* y1 sinP)) | |
| + (* z1 cosPcosT)))) | |
| (make-tfo | |
| - (fl- (fl* cosT cosR) (fl* cosPsinT sinR)) | |
| + (- (* cosT cosR) (* cosPsinT sinR)) | |
| sinPsinT | |
| - (fl+ (fl* cosT sinR) (fl* cosPsinT cosR)) | |
| - (fl* sinP sinR) | |
| + (+ (* cosT sinR) (* cosPsinT cosR)) | |
| + (* sinP sinR) | |
| cosP | |
| - (fl- (fl* sinP cosR)) | |
| - (fl- (fl- (fl* sinT cosR)) (fl* cosPcosT sinR)) | |
| + (- (* sinP cosR)) | |
| + (- (- (* sinT cosR)) (* cosPcosT sinR)) | |
| sinPcosT | |
| - (fl+ (fl- (fl* sinT sinR)) (fl* cosPcosT cosR)) | |
| - (fl- (fl* x cosR) (fl* z sinR)) | |
| + (+ (- (* sinT sinR)) (* cosPcosT cosR)) | |
| + (- (* x cosR) (* z sinR)) | |
| y | |
| - (fl+ (fl* x sinR) (fl* z cosR))))) | |
| + (+ (* x sinR) (* z cosR))))) | |
| ; -- NUCLEIC ACID CONFORMATIONS DATA BASE ------------------------------------- | |
| @@ -3313,7 +3311,7 @@ | |
| (if (= (var-id v) 33) | |
| (let ((p (atom-pos nuc-P (get-var 34 partial-inst))) ; P in nucleotide 34 | |
| (o3* (atom-pos nuc-O3* v))) ; O3' in nucl. 33 | |
| - (fl<=? (pt-dist p o3*) 3.0)) ; check distance | |
| + (<= (pt-dist p o3*) 3.0)) ; check distance | |
| #t)) | |
| (define (anticodon) | |
| @@ -3361,11 +3359,11 @@ | |
| ((18) | |
| (let ((p (atom-pos nuc-P (get-var 19 partial-inst))) | |
| (o3* (atom-pos nuc-O3* v))) | |
| - (fl<=? (pt-dist p o3*) 4.0))) | |
| + (<= (pt-dist p o3*) 4.0))) | |
| ((6) | |
| (let ((p (atom-pos nuc-P (get-var 7 partial-inst))) | |
| (o3* (atom-pos nuc-O3* v))) | |
| - (fl<=? (pt-dist p o3*) 4.5))) | |
| + (<= (pt-dist p o3*) 4.5))) | |
| (else | |
| #t))) | |
| @@ -3449,7 +3447,7 @@ | |
| (define (distance pos) | |
| (let ((abs-pos (tfo-apply (var-tfo v) pos))) | |
| (let ((x (pt-x abs-pos)) (y (pt-y abs-pos)) (z (pt-z abs-pos))) | |
| - (flsqrt (fl+ (fl* x x) (fl* y y) (fl* z z)))))) | |
| + (sqrt (+ (* x x) (* y y) (* z z)))))) | |
| (maximum (map distance (list-of-atoms (var-nuc v))))) | |
| @@ -3464,12 +3462,12 @@ | |
| (if (null? l) | |
| m | |
| (let ((x (car l))) | |
| - (loop (if (fl>? x m) x m) (cdr l)))))) | |
| + (loop (if (> x m) x m) (cdr l)))))) | |
| (define (run input) | |
| (most-distant-atom (pseudoknot input))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| @@ -3482,5 +3480,5 @@ | |
| (lambda () (run (hide count input1))) | |
| (lambda (result) | |
| (and (number? result) | |
| - (let ((x (fl/ result output))) | |
| - (and (fl>? x 0.999999) (fl<? x 1.000001)))))))) | |
| + (let ((x (/ result output))) | |
| + (and (> x 0.999999) (< x 1.000001)))))))) | |
| Index: src/puzzle.sch | |
| =================================================================== | |
| --- src/puzzle.sch (リビジョン 6659) | |
| +++ src/puzzle.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; PUZZLE -- Forest Baskett's Puzzle benchmark, originally written in Pascal. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (my-iota n) | |
| (do ((n n (- n 1)) | |
| @@ -137,7 +135,7 @@ | |
| *kount* | |
| #f))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/ray.sch | |
| =================================================================== | |
| --- src/ray.sch (リビジョン 6659) | |
| +++ src/ray.sch (作業コピー) | |
| @@ -1,11 +1,8 @@ | |
| ;;; RAY -- Ray-trace a simple scene with spheres, generating a ".pgm" file. | |
| ;;; Translated to Scheme from Paul Graham's book ANSI Common Lisp, Example 9.8 | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs files) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| +(use file.util) | |
| (define (make-point x y z) | |
| (vector x y z)) | |
| @@ -14,31 +11,31 @@ | |
| (define (point-y p) (vector-ref p 1)) | |
| (define (point-z p) (vector-ref p 2)) | |
| -(define (sq x) (fl* x x)) | |
| +(define (sq x) (* x x)) | |
| (define (mag x y z) | |
| - (flsqrt (fl+ (sq x) (sq y) (sq z)))) | |
| + (sqrt (+ (sq x) (sq y) (sq z)))) | |
| (define (unit-vector x y z) | |
| (let ((d (mag x y z))) | |
| - (make-point (fl/ x d) (fl/ y d) (fl/ z d)))) | |
| + (make-point (/ x d) (/ y d) (/ z d)))) | |
| (define (distance p1 p2) | |
| - (mag (fl- (point-x p1) (point-x p2)) | |
| - (fl- (point-y p1) (point-y p2)) | |
| - (fl- (point-z p1) (point-z p2)))) | |
| + (mag (- (point-x p1) (point-x p2)) | |
| + (- (point-y p1) (point-y p2)) | |
| + (- (point-z p1) (point-z p2)))) | |
| (define (minroot a b c) | |
| - (if (flzero? a) | |
| - (fl/ (fl- c) b) | |
| - (let ((disc (fl- (sq b) (fl* 4.0 a c)))) | |
| - (if (flnegative? disc) | |
| + (if (zero? a) | |
| + (/ (- c) b) | |
| + (let ((disc (- (sq b) (* 4.0 a c)))) | |
| + (if (negative? disc) | |
| #f | |
| - (let ((discrt (flsqrt disc)) | |
| - (minus-b (fl- b)) | |
| - (two-a (fl* 2.0 a))) | |
| - (flmin (fl/ (fl+ minus-b discrt) two-a) | |
| - (fl/ (fl- minus-b discrt) two-a))))))) | |
| + (let ((discrt (sqrt disc)) | |
| + (minus-b (- b)) | |
| + (two-a (* 2.0 a))) | |
| + (min (/ (+ minus-b discrt) two-a) | |
| + (/ (- minus-b discrt) two-a))))))) | |
| (define *world* '()) | |
| @@ -46,7 +43,7 @@ | |
| (define (tracer pathname res) | |
| (if (file-exists? pathname) | |
| - (delete-file pathname)) | |
| + (remove-file pathname)) | |
| (call-with-output-file | |
| pathname | |
| (lambda (p) | |
| @@ -62,18 +59,18 @@ | |
| (do ((x 0 (+ x 1))) | |
| ((= x extent)) | |
| (write (color-at | |
| - (fl+ -50.0 | |
| - (fl/ (inexact x) (inexact res))) | |
| - (fl+ -50.0 | |
| - (fl/ (inexact y) (inexact res)))) | |
| + (+ -50.0 | |
| + (/ (inexact x) (inexact res))) | |
| + (+ -50.0 | |
| + (/ (inexact y) (inexact res)))) | |
| p) | |
| (newline p))))))) | |
| (define (color-at x y) | |
| - (let ((ray (unit-vector (fl- x (point-x eye)) | |
| - (fl- y (point-y eye)) | |
| - (fl- (point-z eye))))) | |
| - (exact (flround (fl* (sendray eye ray) 255.0))))) | |
| + (let ((ray (unit-vector (- x (point-x eye)) | |
| + (- y (point-y eye)) | |
| + (- (point-z eye))))) | |
| + (exact (round (* (sendray eye ray) 255.0))))) | |
| @@ -82,7 +79,7 @@ | |
| (s (vector-ref x 0)) | |
| (int (vector-ref x 1))) | |
| (if s | |
| - (fl* (lambert s int ray) | |
| + (* (lambert s int ray) | |
| (surface-color s)) | |
| 0.0))) | |
| @@ -94,17 +91,17 @@ | |
| (let ((h (intersect s pt ray))) | |
| (if h | |
| (let ((d (distance h pt))) | |
| - (if (fl<? d dist) | |
| + (if (< d dist) | |
| (loop (cdr lst) s h d) | |
| (loop (cdr lst) surface hit dist))) | |
| (loop (cdr lst) surface hit dist))))))) | |
| (define (lambert s int ray) | |
| (let ((n (normal s int))) | |
| - (flmax 0.0 | |
| - (fl+ (fl* (point-x ray) (point-x n)) | |
| - (fl* (point-y ray) (point-y n)) | |
| - (fl* (point-z ray) (point-z n)))))) | |
| + (max 0.0 | |
| + (+ (* (point-x ray) (point-x n)) | |
| + (* (point-y ray) (point-y n)) | |
| + (* (point-z ray) (point-z n)))))) | |
| (define (make-sphere color radius center) | |
| (vector color radius center)) | |
| @@ -130,19 +127,19 @@ | |
| (zr (point-z ray)) | |
| (c (sphere-center s)) | |
| (n (minroot | |
| - (fl+ (sq xr) (sq yr) (sq zr)) | |
| - (fl* 2.0 | |
| - (fl+ (fl* (fl- (point-x pt) (point-x c)) xr) | |
| - (fl* (fl- (point-y pt) (point-y c)) yr) | |
| - (fl* (fl- (point-z pt) (point-z c)) zr))) | |
| - (fl+ (sq (fl- (point-x pt) (point-x c))) | |
| - (sq (fl- (point-y pt) (point-y c))) | |
| - (sq (fl- (point-z pt) (point-z c))) | |
| - (fl- (sq (sphere-radius s))))))) | |
| + (+ (sq xr) (sq yr) (sq zr)) | |
| + (* 2.0 | |
| + (+ (* (- (point-x pt) (point-x c)) xr) | |
| + (* (- (point-y pt) (point-y c)) yr) | |
| + (* (- (point-z pt) (point-z c)) zr))) | |
| + (+ (sq (- (point-x pt) (point-x c))) | |
| + (sq (- (point-y pt) (point-y c))) | |
| + (sq (- (point-z pt) (point-z c))) | |
| + (- (sq (sphere-radius s))))))) | |
| (if n | |
| - (make-point (fl+ (point-x pt) (fl* n xr)) | |
| - (fl+ (point-y pt) (fl* n yr)) | |
| - (fl+ (point-z pt) (fl* n zr))) | |
| + (make-point (+ (point-x pt) (* n xr)) | |
| + (+ (point-y pt) (* n yr)) | |
| + (+ (point-z pt) (* n zr))) | |
| #f))) | |
| (define (normal s pt) | |
| @@ -150,9 +147,9 @@ | |
| (define (sphere-normal s pt) | |
| (let ((c (sphere-center s))) | |
| - (unit-vector (fl- (point-x c) (point-x pt)) | |
| - (fl- (point-y c) (point-y pt)) | |
| - (fl- (point-z c) (point-z pt))))) | |
| + (unit-vector (- (point-x c) (point-x pt)) | |
| + (- (point-y c) (point-y pt)) | |
| + (- (point-z c) (point-z pt))))) | |
| (define (ray-test res output-file) | |
| (set! *world* '()) | |
| @@ -164,9 +161,9 @@ | |
| (do ((z 2 (+ z 1))) | |
| ((> z 7)) | |
| (defsphere | |
| - (fl* (inexact x) 200.0) | |
| + (* (inexact x) 200.0) | |
| 300.0 | |
| - (fl* (inexact z) -400.0) | |
| + (* (inexact z) -400.0) | |
| 40.0 | |
| 0.75))) | |
| (tracer output-file res)) | |
| @@ -175,7 +172,7 @@ | |
| (ray-test input output) | |
| 'ok) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/bibfreq2.sch | |
| =================================================================== | |
| --- src/bibfreq2.sch (リビジョン 6659) | |
| +++ src/bibfreq2.sch (作業コピー) | |
| @@ -3,16 +3,12 @@ | |
| ;;; modified by Will Clinger (Nov 2007) | |
| ;;; to use symbol-hash instead of eq? hashtables | |
| -(import (rnrs base) | |
| - (rnrs unicode) | |
| - (rnrs sorting) | |
| - (rnrs hashtables) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (fill input-file h) | |
| (let ((p (open-input-file input-file))) | |
| (define (put ls) | |
| - (hashtable-update! h | |
| + (hash-table-update! h | |
| (string->symbol | |
| (list->string | |
| (reverse ls))) | |
| @@ -42,17 +38,14 @@ | |
| (else (cons (car ls) (list-head (cdr ls) (- n 1)))))) | |
| (define (go input-file) | |
| - (let ((h (make-hashtable symbol-hash eq?))) | |
| + (let ((h (make-hash-table 'eq?))) | |
| (fill input-file h) | |
| - (let-values (((keys vals) (hashtable-entries h))) | |
| - (let ((ls (map cons | |
| - (vector->list keys) | |
| - (vector->list vals)))) | |
| - (list-head | |
| - (list-sort (lambda (a b) (> (cdr a) (cdr b))) ls) | |
| - 10))))) | |
| + (let ((ls (hash-table->alist h))) | |
| + (take | |
| + (sort ls (lambda (a b) (> (cdr a) (cdr b)))) | |
| + 10)))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/read1.sch | |
| =================================================================== | |
| --- src/read1.sch (リビジョン 6659) | |
| +++ src/read1.sch (作業コピー) | |
| @@ -4,10 +4,7 @@ | |
| ;;; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io ports) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| ; | |
| @@ -32,21 +29,21 @@ | |
| (define (read-from-file-benchmark input t) | |
| (call-with-port | |
| - (open-file-input-port input (file-options) 'block t) | |
| + (open-input-file input :buffering :full :encoding t) | |
| (lambda (in) | |
| (do ((x (read in) (read in)) | |
| (y #f x) | |
| (i 0 (+ i 1))) | |
| ((eof-object? x) y))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| (s2 (number->string count)) | |
| (s1 input1) | |
| (name "read1:latin-1") | |
| - (t (make-transcoder (latin-1-codec)))) | |
| + (t 'latin1)) | |
| (run-r6rs-benchmark | |
| (string-append name ":" s2) | |
| count | |
| Index: src/read2.sch | |
| =================================================================== | |
| --- src/read2.sch (リビジョン 6659) | |
| +++ src/read2.sch (作業コピー) | |
| @@ -4,10 +4,7 @@ | |
| ;;; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io ports) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| ; | |
| @@ -32,21 +29,21 @@ | |
| (define (read-from-file-benchmark input t) | |
| (call-with-port | |
| - (open-file-input-port input (file-options) 'block t) | |
| + (open-input-file input :buffering :full :encoding t) | |
| (lambda (in) | |
| (do ((x (read in) (read in)) | |
| (y #f x) | |
| (i 0 (+ i 1))) | |
| ((eof-object? x) y))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| (s2 (number->string count)) | |
| (s1 input1) | |
| (name "read1:utf-8") | |
| - (t (make-transcoder (utf-8-codec)))) | |
| + (t 'utf-8)) | |
| (run-r6rs-benchmark | |
| (string-append name ":" s2) | |
| count | |
| Index: src/read3.sch | |
| =================================================================== | |
| --- src/read3.sch (リビジョン 6659) | |
| +++ src/read3.sch (作業コピー) | |
| @@ -4,10 +4,7 @@ | |
| ;;; | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io ports) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| ; | |
| @@ -32,21 +29,21 @@ | |
| (define (read-from-file-benchmark input t) | |
| (call-with-port | |
| - (open-file-input-port input (file-options) 'block t) | |
| + (open-input-file input :buffering :full :encoding t) | |
| (lambda (in) | |
| (do ((x (read in) (read in)) | |
| (y #f x) | |
| (i 0 (+ i 1))) | |
| ((eof-object? x) y))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| (s2 (number->string count)) | |
| (s1 input1) | |
| (name "read1:utf-16") | |
| - (t (make-transcoder (utf-16-codec)))) | |
| + (t 'utf-16)) | |
| (run-r6rs-benchmark | |
| (string-append name ":" s2) | |
| count | |
| Index: src/triangl.sch | |
| =================================================================== | |
| --- src/triangl.sch (リビジョン 6659) | |
| +++ src/triangl.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; TRIANGL -- Board game benchmark. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define *board* | |
| (list->vector '(1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1))) | |
| @@ -54,7 +52,7 @@ | |
| (attempt i depth) | |
| (car *answer*)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/slatex.sch | |
| =================================================================== | |
| --- src/slatex.sch (リビジョン 6659) | |
| +++ src/slatex.sch (作業コピー) | |
| @@ -4,14 +4,8 @@ | |
| ;This file is compatible for the dialect other | |
| ;(c) Dorai Sitaram, Rice U., 1991, 1994 | |
| -(import | |
| - (rnrs base) | |
| - (rnrs unicode) | |
| - (rnrs lists) | |
| - (rnrs io simple) | |
| - (rnrs files) | |
| - (rnrs mutable-pairs) | |
| - (rnrs mutable-strings)) | |
| +(use common) | |
| +(use file.util) | |
| (define *op-sys* 'unix) | |
| @@ -139,7 +133,7 @@ | |
| (define slatex.file-exists? (lambda (f) (file-exists? f))) | |
| -(define slatex.delete-file (lambda (f) (delete-file f))) | |
| +(define slatex.delete-file (lambda (f) (remove-file f))) | |
| (define slatex.force-output (lambda z 'assume-output-forced)) | |
| @@ -2344,7 +2338,7 @@ | |
| ((eq? typ 'input) (slatex.read-filename in)) | |
| (else (slatex.error 'slatex.inline-protected 1))))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/sboyer.sch | |
| =================================================================== | |
| --- src/sboyer.sch (リビジョン 6659) | |
| +++ src/sboyer.sch (作業コピー) | |
| @@ -55,12 +55,9 @@ | |
| ; The second phase creates the test problem, and tests to see | |
| ; whether it is implied by the lemmas. | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input (read)) | |
| (output (read)) | |
| Index: src/paraffins.sch | |
| =================================================================== | |
| --- src/paraffins.sch (リビジョン 6659) | |
| +++ src/paraffins.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; PARAFFINS -- Compute how many paraffins exist with N carbon atoms. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (gen n) | |
| (let* ((n/2 (div n 2)) | |
| @@ -170,7 +169,7 @@ | |
| (+ (length (vector-ref x 0)) | |
| (length (vector-ref x 1))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/dderiv.sch | |
| =================================================================== | |
| --- src/dderiv.sch (リビジョン 6659) | |
| +++ src/dderiv.sch (作業コピー) | |
| @@ -3,10 +3,7 @@ | |
| ;;; Returns the wrong answer for quotients. | |
| ;;; Fortunately these aren't used in the benchmark. | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs hashtables) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| (define (lookup key table) | |
| (let loop ((x table)) | |
| @@ -17,10 +14,10 @@ | |
| pair | |
| (loop (cdr x))))))) | |
| -(define properties (make-hashtable symbol-hash eq?)) | |
| +(define properties (make-hash-table 'eq?)) | |
| (define (get key1 key2) | |
| - (let ((x (hashtable-ref properties key1 #f))) | |
| + (let ((x (hash-table-get properties key1 #f))) | |
| (if x | |
| (let ((y (lookup key2 x))) | |
| (if y | |
| @@ -29,13 +26,13 @@ | |
| #f))) | |
| (define (put key1 key2 val) | |
| - (let ((x (hashtable-ref properties key1 #f))) | |
| + (let ((x (hash-table-get properties key1 #f))) | |
| (if x | |
| (let ((y (lookup key2 x))) | |
| (if y | |
| (set-cdr! y val) | |
| (set-cdr! x (cons (cons key2 val) (cdr x))))) | |
| - (hashtable-set! properties key1 (list (cons key2 val)))))) | |
| + (hash-table-put! properties key1 (list (cons key2 val)))))) | |
| (define (my+dderiv a) | |
| (cons '+ | |
| @@ -76,7 +73,7 @@ | |
| (f a) | |
| (error #f "No derivation method available"))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/nqueens.sch | |
| =================================================================== | |
| --- src/nqueens.sch (リビジョン 6659) | |
| +++ src/nqueens.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; NQUEENS -- Compute number of solutions to 8-queens problem. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define trace? #f) | |
| @@ -30,7 +29,7 @@ | |
| (my-try (iota1 n) '() '())) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/fft.sch | |
| =================================================================== | |
| --- src/fft.sch (リビジョン 6659) | |
| +++ src/fft.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; FFT - Fast Fourier Transform, translated from "Numerical Recipes in C" | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| ;(define flsin sin) | |
| @@ -33,12 +31,12 @@ | |
| (let loop3 ((mmax 2)) | |
| (if (< mmax n) | |
| (let* ((theta | |
| - (fl/ pi*2 (inexact mmax))) | |
| + (/ pi*2 (inexact mmax))) | |
| (wpr | |
| - (let ((x (flsin (fl* 0.5 theta)))) | |
| - (fl* -2.0 (fl* x x)))) | |
| + (let ((x (sin (* 0.5 theta)))) | |
| + (* -2.0 (* x x)))) | |
| (wpi | |
| - (flsin theta))) | |
| + (sin theta))) | |
| (let loop4 ((wr 1.0) (wi 0.0) (m 0)) | |
| (if (< m mmax) | |
| (begin | |
| @@ -47,24 +45,24 @@ | |
| (let* ((j | |
| (+ i mmax)) | |
| (tempr | |
| - (fl- | |
| - (fl* wr (vector-ref data j)) | |
| - (fl* wi (vector-ref data (+ j 1))))) | |
| + (- | |
| + (* wr (vector-ref data j)) | |
| + (* wi (vector-ref data (+ j 1))))) | |
| (tempi | |
| - (fl+ | |
| - (fl* wr (vector-ref data (+ j 1))) | |
| - (fl* wi (vector-ref data j))))) | |
| + (+ | |
| + (* wr (vector-ref data (+ j 1))) | |
| + (* wi (vector-ref data j))))) | |
| (vector-set! data j | |
| - (fl- (vector-ref data i) tempr)) | |
| + (- (vector-ref data i) tempr)) | |
| (vector-set! data (+ j 1) | |
| - (fl- (vector-ref data (+ i 1)) tempi)) | |
| + (- (vector-ref data (+ i 1)) tempi)) | |
| (vector-set! data i | |
| - (fl+ (vector-ref data i) tempr)) | |
| + (+ (vector-ref data i) tempr)) | |
| (vector-set! data (+ i 1) | |
| - (fl+ (vector-ref data (+ i 1)) tempi)) | |
| + (+ (vector-ref data (+ i 1)) tempi)) | |
| (loop5 (+ j mmax)));***)) | |
| - (loop4 (fl+ (fl- (fl* wr wpr) (fl* wi wpi)) wr) | |
| - (fl+ (fl+ (fl* wi wpr) (fl* wr wpi)) wi) | |
| + (loop4 (+ (- (* wr wpr) (* wi wpi)) wr) | |
| + (+ (+ (* wi wpr) (* wr wpi)) wi) | |
| (+ m 2))))) | |
| ));****** | |
| (loop3 (* mmax 2))))))) | |
| @@ -76,7 +74,7 @@ | |
| (four1 data) | |
| (vector-ref data 0)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/earley.sch | |
| =================================================================== | |
| --- src/earley.sch (リビジョン 6659) | |
| +++ src/earley.sch (作業コピー) | |
| @@ -123,9 +123,7 @@ | |
| ; Enders of V = (5 19 20) | |
| ; Predictors of V = (15 17) | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (make-parser grammar lexer) | |
| @@ -648,7 +646,7 @@ | |
| (n (length input))) | |
| (length (parse->trees x 's 0 n))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/simplex.sch | |
| =================================================================== | |
| --- src/simplex.sch (リビジョン 6659) | |
| +++ src/simplex.sch (作業コピー) | |
| @@ -1,9 +1,6 @@ | |
| ;;; SIMPLEX -- Simplex algorithm. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (matrix-rows a) (vector-length a)) | |
| (define (matrix-columns a) (vector-length (vector-ref a 0))) | |
| @@ -39,11 +36,11 @@ | |
| (set! kp (vector-ref l1 0)) | |
| (set! bmax (matrix-ref a mm kp)) | |
| (do ((k 1 (+ k 1))) ((>= k nl1)) | |
| - (if (flpositive? | |
| + (if (positive? | |
| (if abs? | |
| - (fl- (flabs (matrix-ref a mm (vector-ref l1 k))) | |
| - (flabs bmax)) | |
| - (fl- (matrix-ref a mm (vector-ref l1 k)) bmax))) | |
| + (- (abs (matrix-ref a mm (vector-ref l1 k))) | |
| + (abs bmax)) | |
| + (- (matrix-ref a mm (vector-ref l1 k)) bmax))) | |
| (begin | |
| (set! kp (vector-ref l1 k)) | |
| (set! bmax (matrix-ref a mm (vector-ref l1 k))))))) | |
| @@ -53,59 +50,59 @@ | |
| (flag? #f)) | |
| (do ((i 0 (+ i 1))) ((= i m)) | |
| (if flag? | |
| - (if (fl<? (matrix-ref a (vector-ref l2 i) kp) (fl- *epsilon*)) | |
| + (if (< (matrix-ref a (vector-ref l2 i) kp) (- *epsilon*)) | |
| (begin | |
| - (let ((q (fl/ (fl- (matrix-ref a (vector-ref l2 i) 0)) | |
| + (let ((q (/ (- (matrix-ref a (vector-ref l2 i) 0)) | |
| (matrix-ref a (vector-ref l2 i) kp)))) | |
| (cond | |
| - ((fl<? q q1) | |
| + ((< q q1) | |
| (set! ip (vector-ref l2 i)) | |
| (set! q1 q)) | |
| - ((fl=? q q1) | |
| + ((= q q1) | |
| (let ((qp 0.0) | |
| (q0 0.0)) | |
| (let loop ((k 1)) | |
| (if (<= k n) | |
| (begin | |
| (set! qp | |
| - (fl/ (fl- (matrix-ref a ip k)) | |
| + (/ (- (matrix-ref a ip k)) | |
| (matrix-ref a ip kp))) | |
| (set! q0 | |
| - (fl/ | |
| - (fl- | |
| + (/ | |
| + (- | |
| (matrix-ref a (vector-ref l2 i) k)) | |
| (matrix-ref a (vector-ref l2 i) kp))) | |
| - (if (fl=? q0 qp) | |
| + (if (= q0 qp) | |
| (loop (+ k 1)))))) | |
| - (if (fl<? q0 qp) | |
| + (if (< q0 qp) | |
| (set! ip (vector-ref l2 i))))))))) | |
| - (if (fl<? (matrix-ref a (vector-ref l2 i) kp) (fl- *epsilon*)) | |
| + (if (< (matrix-ref a (vector-ref l2 i) kp) (- *epsilon*)) | |
| (begin | |
| - (set! q1 (fl/ (fl- (matrix-ref a (vector-ref l2 i) 0)) | |
| + (set! q1 (/ (- (matrix-ref a (vector-ref l2 i) 0)) | |
| (matrix-ref a (vector-ref l2 i) kp))) | |
| (set! ip (vector-ref l2 i)) | |
| (set! flag? #t))))))) | |
| (define (simp3 one?) | |
| - (let ((piv (fl/ (matrix-ref a ip kp)))) | |
| + (let ((piv (/ (matrix-ref a ip kp)))) | |
| (do ((ii 0 (+ ii 1))) ((= ii (+ m (if one? 2 1)))) | |
| (if (not (= ii ip)) | |
| (begin | |
| - (matrix-set! a ii kp (fl* piv (matrix-ref a ii kp))) | |
| + (matrix-set! a ii kp (* piv (matrix-ref a ii kp))) | |
| (do ((kk 0 (+ kk 1))) ((= kk (+ n 1))) | |
| (if (not (= kk kp)) | |
| (matrix-set! | |
| - a ii kk (fl- (matrix-ref a ii kk) | |
| - (fl* (matrix-ref a ip kk) | |
| + a ii kk (- (matrix-ref a ii kk) | |
| + (* (matrix-ref a ip kk) | |
| (matrix-ref a ii kp))))))))) | |
| (do ((kk 0 (+ kk 1))) ((= kk (+ n 1))) | |
| (if (not (= kk kp)) | |
| - (matrix-set! a ip kk (fl* (fl- piv) (matrix-ref a ip kk))))) | |
| + (matrix-set! a ip kk (* (- piv) (matrix-ref a ip kk))))) | |
| (matrix-set! a ip kp piv))) | |
| (do ((k 0 (+ k 1))) ((= k n)) | |
| (vector-set! l1 k (+ k 1)) | |
| (vector-set! izrov k k)) | |
| (do ((i 0 (+ i 1))) ((= i m)) | |
| - (if (flnegative? (matrix-ref a (+ i 1) 0)) | |
| + (if (negative? (matrix-ref a (+ i 1) 0)) | |
| (complain)) | |
| (vector-set! l2 i (+ i 1)) | |
| (vector-set! iposv i (+ n i))) | |
| @@ -113,20 +110,20 @@ | |
| (if (positive? (+ m2 m3)) | |
| (begin | |
| (do ((k 0 (+ k 1))) ((= k (+ n 1))) | |
| - (do ((i (+ m1 1) (+ i 1)) (sum 0.0 (fl+ sum (matrix-ref a i k)))) | |
| - ((> i m) (matrix-set! a (+ m 1) k (fl- sum))))) | |
| + (do ((i (+ m1 1) (+ i 1)) (sum 0.0 (+ sum (matrix-ref a i k)))) | |
| + ((> i m) (matrix-set! a (+ m 1) k (- sum))))) | |
| (let loop () | |
| (simp1 (+ m 1) #f) | |
| (cond | |
| - ((fl<=? bmax *epsilon*) | |
| - (cond ((fl<? (matrix-ref a (+ m 1) 0) (fl- *epsilon*)) | |
| + ((<= bmax *epsilon*) | |
| + (cond ((< (matrix-ref a (+ m 1) 0) (- *epsilon*)) | |
| (set! pass2? #f)) | |
| - ((fl<=? (matrix-ref a (+ m 1) 0) *epsilon*) | |
| + ((<= (matrix-ref a (+ m 1) 0) *epsilon*) | |
| (let loop ((ip1 m12)) | |
| (if (<= ip1 m) | |
| (cond ((= (vector-ref iposv (- ip1 1)) (+ ip n -1)) | |
| (simp1 ip1 #t) | |
| - (cond ((flpositive? bmax) | |
| + (cond ((positive? bmax) | |
| (set! ip ip1) | |
| (set! one? #t)) | |
| (else | |
| @@ -137,7 +134,7 @@ | |
| (if (vector-ref l3 (- i (+ m1 1))) | |
| (do ((k 0 (+ k 1))) ((= k (+ n 1))) | |
| (matrix-set! | |
| - a i k (fl- (matrix-ref a i k))))))))) | |
| + a i k (- (matrix-ref a i k))))))))) | |
| (else | |
| (simp2) | |
| (if (zero? ip) (set! pass2? #f) (set! one? #t))))) | |
| @@ -157,17 +154,17 @@ | |
| (do ((is k (+ is 1))) ((>= is nl1)) | |
| (vector-set! l1 is (vector-ref l1 (+ is 1)))) | |
| (matrix-set! | |
| - a (+ m 1) kp (fl+ (matrix-ref a (+ m 1) kp) 1.0)) | |
| + a (+ m 1) kp (+ (matrix-ref a (+ m 1) kp) 1.0)) | |
| (do ((i 0 (+ i 1))) ((= i (+ m 2))) | |
| - (matrix-set! a i kp (fl- (matrix-ref a i kp)))))))) | |
| + (matrix-set! a i kp (- (matrix-ref a i kp)))))))) | |
| ((and (>= (vector-ref iposv (- ip 1)) (+ n m1)) | |
| (vector-ref l3 | |
| (- (vector-ref iposv (- ip 1)) (+ m1 n)))) | |
| (vector-set! l3 (- (vector-ref iposv (- ip 1)) (+ m1 n)) #f) | |
| (matrix-set! | |
| - a (+ m 1) kp (fl+ (matrix-ref a (+ m 1) kp) 1.0)) | |
| + a (+ m 1) kp (+ (matrix-ref a (+ m 1) kp) 1.0)) | |
| (do ((i 0 (+ i 1))) ((= i (+ m 2))) | |
| - (matrix-set! a i kp (fl- (matrix-ref a i kp)))))) | |
| + (matrix-set! a i kp (- (matrix-ref a i kp)))))) | |
| (let ((t (vector-ref izrov (- kp 1)))) | |
| (vector-set! izrov (- kp 1) (vector-ref iposv (- ip 1))) | |
| (vector-set! iposv (- ip 1) t)) | |
| @@ -176,7 +173,7 @@ | |
| (let loop () | |
| (simp1 0 #f) | |
| (cond | |
| - ((flpositive? bmax) | |
| + ((positive? bmax) | |
| (simp2) | |
| (cond ((zero? ip) #t) | |
| (else (simp3 #f) | |
| @@ -196,7 +193,7 @@ | |
| (vector 0.0 0.0 0.0 0.0 0.0)) | |
| 2 1 1)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/quicksort.sch | |
| =================================================================== | |
| --- src/quicksort.sch (リビジョン 6659) | |
| +++ src/quicksort.sch (作業コピー) | |
| @@ -1,10 +1,7 @@ | |
| ; This is probably from Lars Hansen's MS thesis. | |
| ; The quick-1 benchmark. (Figure 35, page 132.) | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (quick-1 v less?) | |
| @@ -92,32 +89,32 @@ | |
| (set! random-flonum | |
| (lambda () | |
| (let ((seed seed)) ; make it local | |
| - (let ((p1 (fl- (fl* a12 (vector-ref seed 1)) | |
| - (fl* a13n (vector-ref seed 0)))) | |
| - (p2 (fl- (fl* a21 (vector-ref seed 5)) | |
| - (fl* a23n (vector-ref seed 3))))) | |
| - (let ((k1 (truncate (fl/ p1 m1))) | |
| - (k2 (truncate (fl/ p2 m2))) | |
| + (let ((p1 (- (* a12 (vector-ref seed 1)) | |
| + (* a13n (vector-ref seed 0)))) | |
| + (p2 (- (* a21 (vector-ref seed 5)) | |
| + (* a23n (vector-ref seed 3))))) | |
| + (let ((k1 (truncate (/ p1 m1))) | |
| + (k2 (truncate (/ p2 m2))) | |
| (ignore1 (vector-set! seed 0 (vector-ref seed 1))) | |
| (ignore3 (vector-set! seed 3 (vector-ref seed 4)))) | |
| - (let ((p1 (fl- p1 (fl* k1 m1))) | |
| - (p2 (fl- p2 (fl* k2 m2))) | |
| + (let ((p1 (- p1 (* k1 m1))) | |
| + (p2 (- p2 (* k2 m2))) | |
| (ignore2 (vector-set! seed 1 (vector-ref seed 2))) | |
| (ignore4 (vector-set! seed 4 (vector-ref seed 5)))) | |
| - (let ((p1 (if (fl<? p1 0.0) (fl+ p1 m1) p1)) | |
| - (p2 (if (fl<? p2 0.0) (fl+ p2 m2) p2))) | |
| + (let ((p1 (if (< p1 0.0) (+ p1 m1) p1)) | |
| + (p2 (if (< p2 0.0) (+ p2 m2) p2))) | |
| (vector-set! seed 2 p1) | |
| (vector-set! seed 5 p2) | |
| - (if (fl<=? p1 p2) | |
| - (fl* norm (fl+ (fl- p1 p2) m1)) | |
| - (fl* norm (fl- p1 p2)))))))))) | |
| + (if (<= p1 p2) | |
| + (* norm (+ (- p1 p2) m1)) | |
| + (* norm (- p1 p2)))))))))) | |
| (set! seed-ref (lambda () (vector->list seed))) | |
| (set! seed-set! (lambda l (set! seed (list->vector l))))) | |
| (define (random n) | |
| - (exact (fltruncate (fl* (inexact n) (random-flonum))))) | |
| + (exact (truncate (* (inexact n) (random-flonum))))) | |
| ;;; Even with the improved random number generator, | |
| ;;; this benchmark still spends almost all of its time | |
| @@ -125,7 +122,7 @@ | |
| ;;; quicksort benchmark, we generate a relatively small | |
| ;;; random vector and then sort many copies of it. | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/sum1.sch | |
| =================================================================== | |
| --- src/sum1.sch (リビジョン 6659) | |
| +++ src/sum1.sch (作業コピー) | |
| @@ -1,14 +1,12 @@ | |
| ;;; SUM1 -- One of the Kernighan and Van Wyk benchmarks. | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (sumport port sum-so-far) | |
| (let ((x (read port))) | |
| (if (eof-object? x) | |
| sum-so-far | |
| - (sumport port (fl+ x sum-so-far))))) | |
| + (sumport port (+ x sum-so-far))))) | |
| (define (sum port) | |
| (sumport port 0.0)) | |
| @@ -16,7 +14,7 @@ | |
| (define (go input) | |
| (call-with-input-file input sum)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| @@ -27,5 +25,5 @@ | |
| (string-append name ":" s2) | |
| count | |
| (lambda () (go (hide count input1))) | |
| - (lambda (result) (fl<=? (flabs (fl- result output)) 1e-9))))) | |
| + (lambda (result) (<= (abs (- result output)) 1e-9))))) | |
| Index: src/tail.sch | |
| =================================================================== | |
| --- src/tail.sch (リビジョン 6659) | |
| +++ src/tail.sch (作業コピー) | |
| @@ -7,32 +7,30 @@ | |
| ;;; is produced, and the lines are then written to the output | |
| ;;; in the reverse of the order in which they were read. | |
| -(import (rnrs base) | |
| - (rnrs io ports) | |
| - (rnrs io simple) | |
| - (rnrs files)) | |
| +(use common) | |
| +(use file.util) | |
| (define (tail-r-aux port file-so-far) | |
| - (let ((x (get-line port))) | |
| + (let ((x (read-line port))) | |
| (if (eof-object? x) | |
| file-so-far | |
| (tail-r-aux port (cons x file-so-far))))) | |
| (define (echo-lines-in-reverse-order in out) | |
| - (for-each (lambda (line) (put-string out line) (newline out)) | |
| + (for-each (lambda (line) (display line out) (newline out)) | |
| (tail-r-aux in '()))) | |
| (define (go input output) | |
| (call-with-input-file | |
| input | |
| (lambda (in) | |
| - (if (file-exists? output) (delete-file output)) | |
| + (if (file-exists? output) (remove-file output)) | |
| (call-with-output-file | |
| output | |
| (lambda (out) | |
| (echo-lines-in-reverse-order in out)))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/sumfp.sch | |
| =================================================================== | |
| --- src/sumfp.sch (リビジョン 6659) | |
| +++ src/sumfp.sch (作業コピー) | |
| @@ -1,16 +1,14 @@ | |
| ;;; SUMFP -- Compute sum of integers from 0 to 10000 using floating point | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (run n) | |
| (let loop ((i n) (sum 0.)) | |
| - (if (fl<? i 0.) | |
| + (if (< i 0.) | |
| sum | |
| - (loop (fl- i 1.) (fl+ i sum))))) | |
| + (loop (- i 1.) (+ i sum))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/maze.sch | |
| =================================================================== | |
| --- src/maze.sch (リビジョン 6659) | |
| +++ src/maze.sch (作業コピー) | |
| @@ -10,11 +10,8 @@ | |
| ;;; Rehacked by Olin 4/1995. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic bitwise) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| +(use srfi-60) | |
| (define (random-state n) | |
| (cons n #f)) | |
| @@ -680,7 +677,7 @@ | |
| (pmaze nrows ncols) | |
| (reverse output)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/array1.sch | |
| =================================================================== | |
| --- src/array1.sch (リビジョン 6659) | |
| +++ src/array1.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (create-x n) | |
| (define result (make-vector n)) | |
| @@ -27,7 +25,7 @@ | |
| (loop (- repeat 1) (my-try n)) | |
| result))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/browse.sch | |
| =================================================================== | |
| --- src/browse.sch (リビジョン 6659) | |
| +++ src/browse.sch (作業コピー) | |
| @@ -1,11 +1,7 @@ | |
| ;;; BROWSE -- Benchmark to create and browse through | |
| ;;; an AI-like data base of units. | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs control) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| (define (lookup key table) | |
| (let loop ((x table)) | |
| @@ -193,7 +189,7 @@ | |
| ((null? p)) | |
| (my-match (car pats) (car p) '()))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/diviter.sch | |
| =================================================================== | |
| --- src/diviter.sch (リビジョン 6659) | |
| +++ src/diviter.sch (作業コピー) | |
| @@ -1,8 +1,6 @@ | |
| ;;; DIVITER -- Benchmark which divides by 2 using lists of n ()'s. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (create-n n) | |
| (do ((n n (- n 1)) | |
| @@ -14,7 +12,7 @@ | |
| (a '() (cons (car l) a))) | |
| ((null? l) a))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/cat.sch | |
| =================================================================== | |
| --- src/cat.sch (リビジョン 6659) | |
| +++ src/cat.sch (作業コピー) | |
| @@ -1,9 +1,8 @@ | |
| ;;; CAT -- One of the Kernighan and Van Wyk benchmarks. | |
| ;;; Rewritten by Will Clinger into more idiomatic Scheme. | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs files)) | |
| +(use common) | |
| +(use file.util) | |
| (define (catport in out) | |
| (let ((x (read-char in))) | |
| @@ -14,7 +13,7 @@ | |
| (define (go input-file output-file) | |
| (if (file-exists? output-file) | |
| - (delete-file output-file)) | |
| + (remove-file output-file)) | |
| (call-with-input-file | |
| input-file | |
| (lambda (in) | |
| @@ -23,7 +22,7 @@ | |
| (lambda (out) | |
| (catport in out)))))) | |
| -(define (main) | |
| +(define (main arg) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/peval.sch | |
| =================================================================== | |
| --- src/peval.sch (リビジョン 6659) | |
| +++ src/peval.sch (作業コピー) | |
| @@ -1,9 +1,6 @@ | |
| ;;; PEVAL -- A simple partial evaluator for Scheme, written by Marc Feeley. | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| ;------------------------------------------------------------------------------ | |
| @@ -628,7 +625,7 @@ | |
| (list '(a b c d e f g h i j k l m n o p q r s t u v w x y z))) | |
| (try-peval input1 input2))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/deriv.sch | |
| =================================================================== | |
| --- src/deriv.sch (リビジョン 6659) | |
| +++ src/deriv.sch (作業コピー) | |
| @@ -1,7 +1,6 @@ | |
| ;;; DERIV -- Symbolic derivation. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ;;; Returns the wrong answer for quotients. | |
| ;;; Fortunately these aren't used in the benchmark. | |
| @@ -34,7 +33,7 @@ | |
| (else | |
| (error #f "No derivation method available")))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/mbrotZ.sch | |
| =================================================================== | |
| --- src/mbrotZ.sch (リビジョン 6659) | |
| +++ src/mbrotZ.sch (作業コピー) | |
| @@ -1,15 +1,13 @@ | |
| ;;; MBROT -- Generation of Mandelbrot set fractal | |
| ;;; using Scheme's complex numbers. | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (count z0 step z) | |
| (let* ((max-count 64) | |
| (radius 4.0) | |
| - (radius^2 (fl* radius radius))) | |
| + (radius^2 (* radius radius))) | |
| (let ((z0 (+ z0 (* z step)))) | |
| @@ -19,9 +17,9 @@ | |
| c | |
| (let* ((zr (real-part z)) | |
| (zi (imag-part z)) | |
| - (zr^2 (fl* zr zr)) | |
| - (zi^2 (fl* zi zi))) | |
| - (if (fl>? (fl+ zr^2 zi^2) radius^2) | |
| + (zr^2 (* zr zr)) | |
| + (zi^2 (* zi zi))) | |
| + (if (> (+ zr^2 zi^2) radius^2) | |
| c | |
| (loop (+ (* z z) z0) (+ c 1))))))))) | |
| @@ -50,7 +48,7 @@ | |
| (mbrot matrix -1.0-0.5i 0.005 n) | |
| (vector-ref (vector-ref matrix 0) 0))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/mperm.sch | |
| =================================================================== | |
| --- src/mperm.sch (リビジョン 6659) | |
| +++ src/mperm.sch (作業コピー) | |
| @@ -13,9 +13,7 @@ | |
| ; 000820 / wdc Added the MpermNKL benchmark; revised for new run-benchmark. | |
| ; 071127 / wdc Simplified and ported for R6RS. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs io simple)) | |
| +(use common) | |
| ; This benchmark is in three parts. Each tests a different aspect of | |
| ; the memory system. | |
| @@ -195,7 +193,7 @@ | |
| (define (run-benchmark . args) | |
| (apply run-r6rs-benchmark args)) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((input1 (read)) | |
| (input2 (read)) | |
| (input3 (read)) | |
| Index: src/cpstak.sch | |
| =================================================================== | |
| --- src/cpstak.sch (リビジョン 6659) | |
| +++ src/cpstak.sch (作業コピー) | |
| @@ -1,8 +1,7 @@ | |
| ;;; CPSTAK -- A continuation-passing version of the TAK benchmark. | |
| ;;; A good test of first class procedures and tail recursion. | |
| -(import (rnrs base) | |
| - (rnrs io simple)) | |
| +(use common) | |
| (define (cpstak x y z) | |
| @@ -25,7 +24,7 @@ | |
| (tak x y z (lambda (a) a))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (input2 (read)) | |
| Index: src/lattice.sch | |
| =================================================================== | |
| --- src/lattice.sch (リビジョン 6659) | |
| +++ src/lattice.sch (作業コピー) | |
| @@ -1,9 +1,6 @@ | |
| ;;; LATTICE -- Obtained from Andrew Wright. | |
| -(import (rnrs base) | |
| - (rnrs lists) | |
| - (rnrs io simple) | |
| - (rnrs mutable-pairs)) | |
| +(use common) | |
| ; Given a comparison routine that returns one of | |
| ; less | |
| @@ -226,7 +223,7 @@ | |
| (count-maps l5 l5))) | |
| (else (assertion-violation 'run "unanticipated problem size" k))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) | |
| Index: src/fibfp.sch | |
| =================================================================== | |
| --- src/fibfp.sch (リビジョン 6659) | |
| +++ src/fibfp.sch (作業コピー) | |
| @@ -1,16 +1,14 @@ | |
| ;;; FIBFP -- Computes fib(35) using floating point | |
| -(import (rnrs base) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| (define (fibfp n) | |
| - (if (fl<? n 2.) | |
| + (if (< n 2.) | |
| n | |
| - (fl+ (fibfp (fl- n 1.)) | |
| - (fibfp (fl- n 2.))))) | |
| + (+ (fibfp (- n 1.)) | |
| + (fibfp (- n 2.))))) | |
| -(define (main) | |
| +(define (main args) | |
| (let* ((count (read)) | |
| (input (read)) | |
| (output (read)) | |
| Index: src/gcbench.sch | |
| =================================================================== | |
| --- src/gcbench.sch (リビジョン 6659) | |
| +++ src/gcbench.sch (作業コピー) | |
| @@ -32,11 +32,8 @@ | |
| ; of free memory. There is no portable way to do this in Scheme; each | |
| ; implementation needs its own version. | |
| -(import (rnrs base) | |
| - (rnrs control) | |
| - (rnrs records procedural) | |
| - (rnrs io simple) | |
| - (rnrs arithmetic flonums)) | |
| +(use common) | |
| +(use util.record) | |
| (define (run-benchmark2 name thunk) | |
| (display name) | |
| @@ -44,8 +41,8 @@ | |
| (thunk)) | |
| (define (PrintDiagnostics) | |
| - (display " Total memory available= ???????? bytes") | |
| - (display " Free memory= ???????? bytes") | |
| +;; (display " Total memory available= ???????? bytes") | |
| +;; (display " Free memory= ???????? bytes") | |
| (newline)) | |
| (define (gcbench kStretchTreeDepth) | |
| @@ -76,20 +73,18 @@ | |
| ; Elements 3 and 4 of the allocated vectors are useless. | |
| (let* ((classNode | |
| - (make-record-type-descriptor | |
| - 'classNode #f #f #f #f | |
| - '#((mutable left) (mutable right) (mutable i) (mutable j)))) | |
| - (classNode-cd | |
| - (make-record-constructor-descriptor classNode #f #f)) | |
| - (make-node-raw (record-constructor classNode-cd)) | |
| + (make-record-type | |
| + 'classNode | |
| + '(left right i j))) | |
| + (make-node-raw (record-constructor classNode)) | |
| (make-empty-node (lambda () (make-node-raw 0 0 0 0))) | |
| (make-node | |
| (lambda (l r) | |
| (make-node-raw l r 0 0))) | |
| - (node.left (record-accessor classNode 0)) | |
| - (node.right (record-accessor classNode 1)) | |
| - (node.left-set! (record-mutator classNode 0)) | |
| - (node.right-set! (record-mutator classNode 1))) | |
| + (node.left (record-accessor classNode 'left)) | |
| + (node.right (record-accessor classNode 'right)) | |
| + (node.left-set! (record-modifier classNode 'left)) | |
| + (node.right-set! (record-modifier classNode 'right))) | |
| ; Build tree top down, assigning to older objects. | |
| (define (Populate iDepth thisNode) | |
| @@ -182,7 +177,7 @@ | |
| (main)))) | |
| -(define (main) | |
| +(define (main main) | |
| (let* ((count (read)) | |
| (input1 (read)) | |
| (output (read)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment