conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Fixed bugs in slatex and quicksort benchmarks (library implementation) 

* compiler benchmark now works (taking 10 seconds to compile on this
  machine).
This commit is contained in:
Abdulaziz Ghuloum 2007-11-04 17:00:11 -05:00
parent 8a45a5fe08
commit a1aa10fca9
7 changed files with 2322 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
benchmarks/benchall.ss Executable file
View File

@ -0,0 +1,20 @@
#!/usr/bin/env ikarus --r6rs-script
(import (ikarus))
(define all-benchmarks
'(ack array1 boyer browse cat compiler conform cpstak ctak dderiv
deriv destruc diviter divrec dynamic earley fft fib fibc fibfp
fpsum gcbench gcold graphs lattice matrix maze mazefun mbrot
nbody nboyer nqueens ntakl nucleic paraffins parsing perm9 peval
pi pnpoly primes puzzle quicksort ray sboyer scheme simplex
slatex string sum sum1 sumfp sumloop tail tak takl trav1 trav2
triangl wc))
(for-each
(lambda (x)
(unless (zero? (system (format "ikarus --r6rs-script bench.ss ~a" x)))
(fprintf (standard-error-port) "ERROR: ~s failed\n" x)))
all-benchmarks)

11
benchmarks/rnrs-benchmarks.ss
View File

@ -1,12 +1,13 @@
(library (rnrs-benchmarks)
(export run-benchmark fatal-error include-source
call-with-output-file/truncate
call-with-output-file/truncate fast-run
ack-iters
array1-iters
boyer-iters
browse-iters
cat-iters
compiler-iters
conform-iters
cpstak-iters
ctak-iters
@ -73,7 +74,7 @@
[(ctxt name)
(cons #'begin
(with-input-from-file
(format "r6rs-benchmarks/~a" (syntax->datum #'name))
(format "rnrs-benchmarks/~a" (syntax->datum #'name))
(lambda ()
(let f ()
(let ([x (read)])
@ -85,6 +86,8 @@
(define (fatal-error . args)
(error 'fatal-error "~a"
(apply (lambda (x) (format "~a" x)) args)))
(define fast-run (make-parameter #f))
(define (run-bench count run)
(unless (= count 0)
@ -98,7 +101,9 @@
(let ([run (apply run-maker args)])
(let ([result
(time-it name
(lambda () (run-bench count run)))])
(if (fast-run)
run
(lambda () (run-bench count run))))])
(unless (ok? result)
(error #f "*** wrong result ***")))))

175
benchmarks/rnrs-benchmarks/compiler.ss
View File

@ -23,8 +23,7 @@
(scheme-global-eval (list 'set! var (list 'quote val)) fatal-err))
(define (scheme-global-eval expr err)
;(eval expr)
(fatal-error "scheme-global-eval is no more")
)
(fatal-error "scheme-global-eval is no more"))
(define (pinpoint-error filename line char) #t)
(define file-path-sep #\:)
(define file-ext-sep #\.)
@ -677,8 +676,7 @@
(define ret-var-set (set-singleton ret-var))
(define closure-env-var (make-temp-var 'closure-env))
(define empty-var (make-temp-var #f))
(define make-global-environment #f)
(set! make-global-environment (lambda () (env-frame #f '())))
(define make-global-environment (lambda () (env-frame #f '())))
(define (env-frame env vars) (vector (cons vars #f) '() '() env))
(define (env-new-var! env name source)
(let* ((glob (not (env-parent-ref env)))
@ -843,8 +841,10 @@
(cadr d)
(loop (cdr l))))
(declaration-value name element default (env-parent-ref decls))))))
(define namespace-sym (string->canonical-symbol "NAMESPACE"))
(define-namable-string-decl namespace-sym)
(define namespace-sym
(let ([s (string->canonical-symbol "NAMESPACE")])
(define-namable-string-decl s)
s))
(define (node-parent x) (vector-ref x 1))
(define (node-children x) (vector-ref x 2))
(define (node-fv x) (vector-ref x 3))
@ -1162,16 +1162,21 @@
(define extended-bindings-sym (string->canonical-symbol "EXTENDED-BINDINGS"))
(define safe-sym (string->canonical-symbol "SAFE"))
(define interrupts-enabled-sym (string->canonical-symbol "INTERRUPTS-ENABLED"))
(define-flag-decl ieee-scheme-sym 'dialect)
(define-flag-decl r4rs-scheme-sym 'dialect)
(define-flag-decl multilisp-sym 'dialect)
(define-boolean-decl lambda-lift-sym)
(define-flag-decl block-sym 'compilation-strategy)
(define-flag-decl separate-sym 'compilation-strategy)
(define-namable-boolean-decl standard-bindings-sym)
(define-namable-boolean-decl extended-bindings-sym)
(define-boolean-decl safe-sym)
(define-boolean-decl interrupts-enabled-sym)
(define dummy1
(begin
(define-flag-decl ieee-scheme-sym 'dialect)
(define-flag-decl r4rs-scheme-sym 'dialect)
(define-flag-decl multilisp-sym 'dialect)
(define-boolean-decl lambda-lift-sym)
(define-flag-decl block-sym 'compilation-strategy)
(define-flag-decl separate-sym 'compilation-strategy)
(define-namable-boolean-decl standard-bindings-sym)
(define-namable-boolean-decl extended-bindings-sym)
(define-boolean-decl safe-sym)
(define-boolean-decl interrupts-enabled-sym)
#f))
(define (scheme-dialect decl)
(declaration-value 'dialect #f ieee-scheme-sym decl))
(define (lambda-lift? decl) (declaration-value lambda-lift-sym #f #t decl))
@ -3765,8 +3770,7 @@
(for-each remove-cascade! (queue->list (bbs-bb-queue bbs))))
(define (jump-lbl? branch)
(let ((opnd (jump-opnd branch))) (if (lbl? opnd) (lbl-num opnd) #f)))
(define put-poll-on-ifjump? #f)
(set! put-poll-on-ifjump? #t)
(define put-poll-on-ifjump? #t)
(define (bbs-remove-dead-code! bbs)
(let ((new-bb-queue (queue-empty)) (scan-queue (queue-empty)))
(define (reachable ref bb)
@ -4703,9 +4707,12 @@
(define generic-sym (string->canonical-symbol "GENERIC"))
(define fixnum-sym (string->canonical-symbol "FIXNUM"))
(define flonum-sym (string->canonical-symbol "FLONUM"))
(define-namable-decl generic-sym 'arith)
(define-namable-decl fixnum-sym 'arith)
(define-namable-decl flonum-sym 'arith)
(define dummy2
(begin
(define-namable-decl generic-sym 'arith)
(define-namable-decl fixnum-sym 'arith)
(define-namable-decl flonum-sym 'arith)
#f))
(define (arith-implementation name decls)
(declaration-value 'arith name generic-sym decls))
(define (cf source target-name . opts)
@ -4736,8 +4743,7 @@
(if (and info-port (not (eq? info-port (current-output-port))))
(close-output-port info-port))
result))
(define wrap-program #f)
(set! wrap-program (lambda (program) program))
(define wrap-program (lambda (program) program))
(define (compile-program program target-name opts module-name dest info-port)
(define (compiler-body)
(if (not (valid-module-name? module-name))
@ -5231,12 +5237,9 @@
(make-poll
(or (poll-since-entry? poll) (poll-since-entry? other-poll))
(max (poll-delta poll) (poll-delta other-poll))))
(define poll-period #f)
(set! poll-period 90)
(define poll-head #f)
(set! poll-head 15)
(define poll-tail #f)
(set! poll-tail 15)
(define poll-period 90)
(define poll-head 15)
(define poll-tail 15)
(define (entry-context proc closed)
(define (empty-vars-list n)
(if (> n 0) (cons empty-var (empty-vars-list (- n 1))) '()))
@ -6961,17 +6964,11 @@
(define ofile-nl char-newline)
(define ofile-tab char-tab)
(define ofile-asm? '())
(set! ofile-asm? '())
(define ofile-asm-bits? '())
(set! ofile-asm-bits? #f)
(define ofile-asm-gvm? '())
(set! ofile-asm-gvm? #f)
(define ofile-asm-bits? #f)
(define ofile-asm-gvm? #f)
(define ofile-stats? '())
(set! ofile-stats? '())
(define ofile-add-obj '())
(set! ofile-add-obj '())
(define ofile-syms '())
(set! ofile-syms '())
(define (ofile-word n)
(let ((n (modulo n 65536)))
(if (and ofile-asm? ofile-asm-bits?)
@ -7142,6 +7139,7 @@
'fixnum)
((and (inexact? (real-part obj))
(zero? (imag-part obj))
;;; AZIZ: test looks wrong
(exact? (imag-part obj)))
'flonum)
(else 'subtyped)))
@ -8657,8 +8655,7 @@
(define closure-alloc-trap 15)
(define intr-trap 24)
(define cache-line-length 16)
(define polling-intermittency '())
(set! polling-intermittency 10)
(define polling-intermittency 10)
(define (stat-clear!) (set! *stats* (cons 0 '())))
(define (stat-dump!) (emit-stat (cdr *stats*)))
(define (stat-add! bin count)
@ -10434,6 +10431,8 @@
(if (or fix-safe? (not (safe? decls))) fix-spec proc))
((eq? arith flonum-sym) (if (not (safe? decls)) flo-spec proc))
(else proc)))))))
(define dummy3
(begin
(define-apply "##TYPE" #f (lambda (opnds loc sn) (gen-type opnds loc sn)))
(define-apply
"##TYPE-CAST"
@ -11136,57 +11135,57 @@
(let ((targ (make-target 4 'm68000)))
(target-begin!-set! targ (lambda (info-port) (begin! info-port targ)))
(put-target targ))
)) ; dummy3
(define input-source-code '
(begin
(declare (standard-bindings) (fixnum) (not safe) (block))
(define (fib n)
(if (< n 2)
n
(+ (fib (- n 1))
(fib (- n 2)))))
(define (tak x y z)
(if (not (< y x))
z
(tak (tak (- x 1) y z)
(tak (- y 1) z x)
(tak (- z 1) x y))))
(define (ack m n)
(cond ((= m 0) (+ n 1))
((= n 0) (ack (- m 1) 1))
(else (ack (- m 1) (ack m (- n 1))))))
(define (create-x n)
(define result (make-vector n))
(do ((i 0 (+ i 1)))
((>= i n) result)
(vector-set! result i i)))
(define (create-y x)
(let* ((n (vector-length x))
(result (make-vector n)))
(do ((i (- n 1) (- i 1)))
((< i 0) result)
(vector-set! result i (vector-ref x i)))))
(define (my-try n)
(vector-length (create-y (create-x n))))
(define (go n)
(let loop ((repeat 100)
(result 0))
(if (> repeat 0)
(loop (- repeat 1) (my-try n))
result)))
(+ (fib 20)
(tak 18 12 6)
(ack 3 9)
(go 200000))
))
(begin
(declare (standard-bindings) (fixnum) (not safe) (block))
(define (fib n)
(if (< n 2)
n
(+ (fib (- n 1))
(fib (- n 2)))))
(define (tak x y z)
(if (not (< y x))
z
(tak (tak (- x 1) y z)
(tak (- y 1) z x)
(tak (- z 1) x y))))
(define (ack m n)
(cond ((= m 0) (+ n 1))
((= n 0) (ack (- m 1) 1))
(else (ack (- m 1) (ack m (- n 1))))))
(define (create-x n)
(define result (make-vector n))
(do ((i 0 (+ i 1)))
((>= i n) result)
(vector-set! result i i)))
(define (create-y x)
(let* ((n (vector-length x))
(result (make-vector n)))
(do ((i (- n 1) (- i 1)))
((< i 0) result)
(vector-set! result i (vector-ref x i)))))
(define (my-try n)
(vector-length (create-y (create-x n))))
(define (go n)
(let loop ((repeat 100)
(result 0))
(if (> repeat 0)
(loop (- repeat 1) (my-try n))
result)))
(+ (fib 20)
(tak 18 12 6)
(ack 3 9)
(go 200000))
))
(define output-expected '(
"|------------------------------------------------------"

2
benchmarks/rnrs-benchmarks/quicksort.ss
View File

@ -3,7 +3,7 @@
(library (rnrs-benchmarks quicksort)
(export main)
(import (rnrs) (rnrs mutable-pairs) (rnrs-benchmarks))
(import (except (rnrs) partition) (rnrs mutable-pairs) (rnrs-benchmarks))
(define (quick-1 v less?)

547
benchmarks/rnrs-benchmarks/slatex-data/slatex.sty Normal file
View File

@ -0,0 +1,547 @@
% slatex.sty
% SLaTeX v. 2.2
% style file to be used in (La)TeX when using SLaTeX
% (c) Dorai Sitaram, Rice U., 1991, 1994
% This file (or a soft link to it) should be in some
% directory in your TEXINPUTS path (i.e., the one
% (La)TeX scours for \input or \documentstyle option
% files).
% Do not attempt to debug this file, since the results
% are not transparent just to (La)TeX. The Scheme part
% of SLaTeX depends on information laid out here -- so
% (La)TeX-minded debugging of this file will almost
% inevitably sabotage SLaTeX.
% It's possible you don't find the default style set
% out here appealing: e.g., you may want to change the
% positioning of displayed code; change the fonts for
% keywords, constants, and variables; add new keywords,
% constants, and variables; use your names instead of
% the provided \scheme, [\begin|\end]{schemedisplay},
% [\begin|\end]{schemebox}, (or \[end]schemedisplay,
% \[end]schemebox for TeX), which might be seem too
% long or unmnemonic, and many other things. The clean
% way to do these things is outlined in the
% accompanying manual, slatex-d.tex. This way is both
% easier than messing with this .sty file, and safer
% since you will not unwittingly break SLaTeX.
%%%
% to prevent loading slatex.sty more than once
\ifx\slatexignorecurrentfile\UNDEFINED
\else\endinput\fi
% use \slatexignorecurrentfile to disable slatex for
% the current file. (Unstrangely, the very definition
% disables slatex for the rest of _this_ file, slatex.sty.)
\def\slatexignorecurrentfile{}
% checking whether we're using LaTeX or TeX?
\newif\ifusinglatex
\ifx\newenvironment\UNDEFINED\usinglatexfalse\else\usinglatextrue\fi
% make @ a letter for TeX
\ifusinglatex\relax\else
\edef\atcatcodebeforeslatex{\the\catcode`@}
\catcode`@11
\fi
% identification of TeX/LaTeX style for schemedisplay.
% Do \defslatexenvstyle{tex} to get TeX environment
% style in LaTeX
\def\defslatexenvstyle#1{\gdef\slatexenvstyle{#1}}
\ifusinglatex\defslatexenvstyle{latex}\else\defslatexenvstyle{tex}\fi
% TeX doesn't have sans-serif; use roman instead
\ifx\sf\UNDEFINED\def\sf{\rm}\fi
% tabbing from plain TeX
%
\newif\ifus@ \newif\if@cr
\newbox\tabs \newbox\tabsyet \newbox\tabsdone
%
\def\cleartabs{\global\setbox\tabsyet\null \setbox\tabs\null}
\def\settabs{\setbox\tabs\null \futurelet\next\sett@b}
\let\+=\relax % in case this file is being read in twice
\def\sett@b{\ifx\next\+\let\next\relax
\def\next{\afterassignment\s@tt@b\let\next}%
\else\let\next\s@tcols\fi\next}
\def\s@tt@b{\let\next\relax\us@false\m@ketabbox}
\def\tabalign{\us@true\m@ketabbox} % non-\outer version of \+
\outer\def\+{\tabalign}
\def\s@tcols#1\columns{\count@#1 \dimen@\hsize
\loop\ifnum\count@>\z@ \@nother \repeat}
\def\@nother{\dimen@ii\dimen@ \divide\dimen@ii\count@
\setbox\tabs\hbox{\hbox to\dimen@ii{}\unhbox\tabs}%
\advance\dimen@-\dimen@ii \advance\count@\m@ne}
%
\def\m@ketabbox{\begingroup
\global\setbox\tabsyet\copy\tabs
\global\setbox\tabsdone\null
\def\cr{\@crtrue\crcr\egroup\egroup
\ifus@\unvbox\z@\lastbox\fi\endgroup
\setbox\tabs\hbox{\unhbox\tabsyet\unhbox\tabsdone}}%
\setbox\z@\vbox\bgroup\@crfalse
\ialign\bgroup&\t@bbox##\t@bb@x\crcr}
%
\def\t@bbox{\setbox\z@\hbox\bgroup}
\def\t@bb@x{\if@cr\egroup % now \box\z@ holds the column
\else\hss\egroup \global\setbox\tabsyet\hbox{\unhbox\tabsyet
\global\setbox\@ne\lastbox}% now \box\@ne holds its size
\ifvoid\@ne\global\setbox\@ne\hbox to\wd\z@{}%
\else\setbox\z@\hbox to\wd\@ne{\unhbox\z@}\fi
\global\setbox\tabsdone\hbox{\box\@ne\unhbox\tabsdone}\fi
\box\z@}
% finished (re)defining TeX's tabbing macros
% above from plain.tex; was disabled in lplain.tex. Do
% not modify above unless you really know what you're
% up to. Make all changes you want to following code.
% The new env is preferable to LaTeX's tabbing env
% since latter accepts only a small number of tabs
% following retrieves something like LaTeX's tabbing
% env without the above problem (it also creates a box
% for easy manipulation!)
\def\lat@xtabbing{\leavevmode\hbox\bgroup\vbox\bgroup
\def\={\cleartabs&} \def\>{&} \def\\{\cr\tabalign} \tabalign}
\def\endlat@xtabbing{\cr\egroup\egroup}
%new
\def\lat@xtabbing{\begingroup
\def\={\cleartabs&} \def\>{&}%
\def\\{\cr\tabalign\lat@xtabbingleftmost}%
\tabalign\lat@xtabbingleftmost}
\def\endlat@xtabbing{\cr\endgroup}
\let\lat@xtabbingleftmost\relax
% stuff for formating Scheme code
\newskip\par@nlen \newskip\brack@tlen \newskip\quot@len
\newskip\h@lflambda
\newbox\garb@ge
\def\s@ttowidth#1#2{\setbox\garb@ge\hbox{#2}#1\wd\garb@ge\relax}
\s@ttowidth\par@nlen{$($} % size of paren
\s@ttowidth\brack@tlen{$[$} % size of bracket
\s@ttowidth\quot@len{'} % size of quote indentation
\s@ttowidth\h@lflambda{ii} % size of half of lambda indentation
\def\PRN{\hskip\par@nlen} % these are used by SLaTeX's codesetter
\def\BKT{\hskip\brack@tlen}
\def\QUO{\hskip\quot@len}
\def\HL{\hskip\h@lflambda}
\newskip\abovecodeskip \newskip\belowcodeskip
\newskip\leftcodeskip \newskip\rightcodeskip
% the following default assignments give a flushleft
% display
\abovecodeskip=\medskipamount \belowcodeskip=\medskipamount
\leftcodeskip=0pt \rightcodeskip=0pt
% adjust above,below,left,right codeskip's to personal
% taste
% for centered displays
%
% \leftcodeskip=0pt plus 1fil
% \rightcodeskip=0pt plus 1fil
%
% if \rightcodeskip != 0pt, pagebreaks within Scheme
% blocks in {schemedisplay} are disabled
\def\checkfollpar{\futurelet\next\checkfollparII}
\def\checkfollparII{\ifx\next\par\let\next\relax
\else\par\noindent\let\next\ignorespaces\fi\next}
% the following are the default font assignments for
% words in code. Change them to suit personal taste
\def\keywordfont#1{{\bf #1}}
\def\variablefont#1{{\it #1\/}}
\def\constantfont#1{{\sf #1}}
\def\datafont#1{\constantfont{#1}}
\def\schemecodehook{}
%program listings that allow page breaks but
%can't be centered
\def\ZZZZschemedisplay{\edef\thez@skip{\the\z@skip}%
\edef\@tempa{\the\rightcodeskip}%
\ifx\@tempa\thez@skip\let\next\ZZZZschemeprogram
\else\let\next\ZZZZschemeprogramII\fi\next}
\def\endZZZZschemedisplay{\edef\thez@skip{\the\z@skip}%
\edef\@tempa{\the\rightcodeskip}%
\ifx\@tempa\thez@skip\let\next\endZZZZschemeprogram
\else\let\next\endZZZZschemeprogramII\fi\next}
\def\ZZZZschemeprogram{\vskip\abovecodeskip
\begingroup
\schemecodehook
\let\sy=\keywordfont \let\cn=\constantfont
\let\va=\variablefont \let\dt=\datafont
\def\lat@xtabbingleftmost{\hskip\leftcodeskip\relax}%
\lat@xtabbing}
\def\endZZZZschemeprogram{\endlat@xtabbing
\endgroup
\vskip\belowcodeskip
\ifusinglatex\let\next\@endparenv
\else\let\next\checkfollpar\fi\next}
\def\ZZZZschemeprogramII{\vskip\abovecodeskip
\begingroup
\noindent
%\schemecodehook %\ZZZZschemebox already has it
\hskip\leftcodeskip
\ZZZZschemebox}
\def\endZZZZschemeprogramII{\endZZZZschemebox
\hskip\rightcodeskip
\endgroup
\vskip\belowcodeskip
\ifusinglatex\let\next\@endparenv
\else\let\next\checkfollpar\fi\next}
%
\def\ZZZZschemebox{%
\leavevmode\hbox\bgroup\vbox\bgroup
\schemecodehook
\let\sy=\keywordfont \let\cn=\constantfont
\let\va=\variablefont \let\dt=\datafont
\lat@xtabbing}
\def\endZZZZschemebox{\endlat@xtabbing
\egroup\egroup\ignorespaces}
%in-text
\def\ZZZZschemecodeintext{\begingroup
\let\sy\keywordfont \let\cn\constantfont
\let\va\variablefont \let\dt\datafont}
\def\endZZZZschemecodeintext{\endgroup\ignorespaces}
\def\ZZZZschemeresultintext{\begingroup
\let\sy\datafont \let\cn\constantfont
\let\va\datafont \let\dt\datafont}
\def\endZZZZschemeresultintext{\endgroup\ignorespaces}
% \comm@nt<some-char>...text...<same-char> comments out
% TeX source analogous to
% \verb<some-char>...text...<same-char>. Sp. case:
% \comm@nt{...text...} == \comm@nt}...text...}
\def\@makeother#1{\catcode`#112\relax}
\def\comm@nt{%
\begingroup
\let\do\@makeother \dospecials
\@comm}
\begingroup\catcode`\<1\catcode`\>2
\catcode`\{12\catcode`\}12
\long\gdef\@comm#1<%
\if#1{\long\def\@tempa ##1}<\endgroup>\else
\long\def\@tempa ##1#1<\endgroup>\fi
\@tempa>
\endgroup
% input file if possible, else relax
\def\inputifpossible#1{%
\immediate\openin0=#1\relax%
\ifeof0\relax\else\input#1\relax\fi%
\immediate\closein0}
\def\ZZZZinput#1{\input#1\relax}
% you may replace the above by
%
% \def\ZZZZinput#1{\inputifpossible{#1}}
%
% if you just want to call (La)TeX on your text
% ignoring the portions that need to be SLaTeX'ed
%use \subjobname rather than \jobname to generate
%slatex's temp files --- this allows us to change
%\subjobname for more control, if necessary.
\let\subjobname\jobname
% counter for generating temp file names
\newcount\sch@mefilenamecount
\sch@mefilenamecount=-1
% To produce displayed Scheme code:
% in LaTeX:
% \begin{schemedisplay}
% ... indented program (with sev'l lines) ...
% \end{schemedisplay}
%
% in TeX:
% \schemedisplay
% ... indented program (with sev'l lines) ...
% \endschemedisplay
\begingroup\catcode`\|=0\catcode`\[=1\catcode`\]=2%
\catcode`\{=12\catcode`\}=12\catcode`\\=12%
|gdef|defschemedisplaytoken#1[%
|long|expandafter|gdef|csname ZZZZcomment#1|endcsname[%
|begingroup
|let|do|@makeother |dospecials
|csname ZZZZcomment|slatexenvstyle II#1|endcsname]%
|long|expandafter|gdef|csname ZZZZcommentlatexII#1|endcsname##1\end{#1}[%
|endgroup|end[#1]]%
|long|expandafter|gdef|csname ZZZZcommenttexII#1|endcsname##1\end#1[%
|endgroup|csname end#1|endcsname]%
|long|expandafter|gdef|csname #1|endcsname[%
|global|advance|sch@mefilenamecount by 1|relax%
|ZZZZinput[|filehider Z|number|sch@mefilenamecount|subjobname.tex]%
|csname ZZZZcomment#1|endcsname]%
|long|expandafter|gdef|csname end#1|endcsname[]]%
|endgroup
\defschemedisplaytoken{schemedisplay}
\def\undefschemedisplaytoken#1{%
\expandafter\gdef\csname#1\endcsname{\UNDEFINED}}
% \scheme|...program fragment...| produces Scheme code
% in-text. Sp. case: \scheme{...} == \scheme}...}
\def\defschemetoken#1{%
\long\expandafter\def\csname#1\endcsname{%
\global\advance\sch@mefilenamecount by 1\relax%
\ZZZZinput{\filehider Z\number\sch@mefilenamecount\subjobname.tex}%
\comm@nt}}
\defschemetoken{scheme}
\def\undefschemetoken#1{%
\expandafter\gdef\csname#1\endcsname{\UNDEFINED}}
% \schemeresult|...program fragment...| produces a
% Scheme code result in-text: i.e. keyword or variable
% fonts are replaced by the data font. Sp. case:
% \schemeresult{...} == \schemeresult}...}
\def\defschemeresulttoken#1{%
\long\expandafter\def\csname#1\endcsname{%
\global\advance\sch@mefilenamecount by 1\relax%
\ZZZZinput{\filehider Z\number\sch@mefilenamecount\subjobname.tex}%
\comm@nt}}
\defschemeresulttoken{schemeresult}
\def\undefschemeresulttoken#1{%
\expandafter\gdef\csname#1\endcsname{\UNDEFINED}}
% To produce a box of Scheme code:
% in LaTeX:
% \begin{schemebox}
% ... indented program (with sev'l lines) ...
% \end{schemebox}
%
% in TeX:
% \schemebox
% ... indented program (with sev'l lines) ...
% \endschemebox
\begingroup\catcode`\|=0\catcode`\[=1\catcode`\]=2%
\catcode`\{=12\catcode`\}=12\catcode`\\=12%
|gdef|defschemeboxtoken#1[%
|long|expandafter|gdef|csname ZZZZcomment#1|endcsname[%
|begingroup
|let|do|@makeother |dospecials
|csname ZZZZcomment|slatexenvstyle II#1|endcsname]%
|long|expandafter|gdef|csname ZZZZcommentlatexII#1|endcsname##1\end{#1}[%
|endgroup|end[#1]]%
|long|expandafter|gdef|csname ZZZZcommenttexII#1|endcsname##1\end#1[%
|endgroup|csname end#1|endcsname]%
|long|expandafter|gdef|csname #1|endcsname[%
|global|advance|sch@mefilenamecount by 1|relax%
|ZZZZinput[|filehider Z|number|sch@mefilenamecount|subjobname.tex]%
|csname ZZZZcomment#1|endcsname]%
|long|expandafter|gdef|csname end#1|endcsname[]]%
|endgroup
\defschemeboxtoken{schemebox}
\def\undefschemeboxtoken#1{%
\expandafter\gdef\csname#1\endcsname{\UNDEFINED}}
% for wholesale dumping of all-Scheme files into TeX (converting
% .scm files to .tex),
% use
% \schemeinput{<filename>}
% .scm, .ss, .s extensions optional
\def\defschemeinputtoken#1{%
\long\expandafter\gdef\csname#1\endcsname##1{%
\global\advance\sch@mefilenamecount by 1\relax%
\ZZZZinput{\filehider Z\number\sch@mefilenamecount\subjobname.tex}}}
\defschemeinputtoken{schemeinput}
\def\undefschemeinputtoken#1{%
\expandafter\gdef\csname#1\endcsname{\UNDEFINED}}
% delineating a region that features typeset code
% not usually needed, except when using \scheme and schemedisplay
% inside macro-args and macro-definition-bodies
% in LaTeX:
% \begin{schemeregion}
% ...
% \end{schemeregion}
%
% in TeX:
% \schemeregion
% ...
% \endschemeregion
\begingroup\catcode`\|=0\catcode`\[=1\catcode`\]=2%
\catcode`\{=12\catcode`\}=12\catcode`\\=12%
|gdef|defschemeregiontoken#1[%
|long|expandafter|gdef|csname ZZZZcomment#1|endcsname[%
|begingroup
|let|do|@makeother |dospecials
|csname ZZZZcomment|slatexenvstyle II#1|endcsname]%
|long|expandafter|gdef|csname ZZZZcommentlatexII#1|endcsname##1\end{#1}[%
|endgroup|end[#1]]%
|long|expandafter|gdef|csname ZZZZcommenttexII#1|endcsname##1\end#1[%
|endgroup|csname end#1|endcsname]%
|long|expandafter|gdef|csname #1|endcsname[%
|global|advance|sch@mefilenamecount by 1|relax%
|ZZZZinput[|filehider Z|number|sch@mefilenamecount|subjobname.tex]%
|csname ZZZZcomment#1|endcsname]%
|long|expandafter|gdef|csname end#1|endcsname[]]%
|endgroup
\defschemeregiontoken{schemeregion}
\def\undefschemeregiontoken#1{%
\expandafter\gdef\csname#1\endcsname{\UNDEFINED}}
% introducing new code-tokens to the keyword, variable and constant
% categories
\def\comm@ntII{%
\begingroup
\let\do\@makeother \dospecials
\@commII}
\begingroup\catcode`\[1\catcode`\]2
\catcode`\{12\catcode`\}12
\long\gdef\@commII{[%
\long\def\@tempa ##1}[\endgroup]\@tempa]%
\endgroup
\let\setkeyword\comm@ntII
\let\setvariable\comm@ntII
\let\setconstant\comm@ntII
% \defschememathescape makes the succeeding grouped character an
% escape into latex math from within Scheme code;
% this character can't be }
\let\defschememathescape\comm@ntII
\let\undefschememathescape\comm@ntII
% telling SLaTeX that a certain Scheme identifier is to
% be replaced by the specified LaTeX expression.
% Useful for generating ``mathematical''-looking
% typeset code even though the corresponding Scheme
% code is ascii as usual and doesn't violate
% identifier-naming rules
\def\setspecialsymbol{%
\begingroup
\let\do\@makeother \dospecials
\@commIII}
\begingroup\catcode`\[1\catcode`\]2
\catcode`\{12\catcode`\}12
\long\gdef\@commIII{[%
\long\def\@tempa ##1}[\endgroup\@gobbleI]\@tempa]%
\endgroup
\def\@gobbleI#1{}
% \unsetspecialsymbol strips Scheme identifier(s) of
% any ``mathematical'' look lent by the above
\let\unsetspecialsymbol\comm@ntII
% enabling/disabling slatex
\def\slatexdisable#1{\expandafter\gdef\csname#1\endcsname{}}
% \schemecasesensitive takes either true or false as
% argument
\def\schemecasesensitive#1{}
%for latex only: use \slatexseparateincludes before the
%occurrence of any Scheme code in your file, if you
%want the various \include'd files to have their own
%pool of temporary slatex files. This lets you juggle
%your \include's in successive runs of LaTeX without
%having to worry that the temp. files may interfere.
%By default, only a single pool of temp files is used.
%Warning: On DOS, if your \include'd files have fairly
%similar names, avoid \slatexseparateincludes since the
%short filenames on DOS will likely confuse the temp
%file pools of different \include files.
\def\slatexseparateincludes{%
\gdef\include##1{{\def\subjobname{##1}%
\sch@mefilenamecount=-1%
\@include##1 }}}
% convenient abbreviations for characters
\begingroup
\catcode`\|=0
|catcode`|\=12
|gdef|ttbackslash{{|tt|catcode`|\=12\}}
|endgroup
\mathchardef\lt="313C
\mathchardef\gt="313E
\begingroup
\catcode`\@12%
\global\let\atsign@%
\endgroup
\chardef\dq=`\"
% leading character of slatex filenames: . for unix to
% keep them out of the way
\def\filehider{.}
% since the above doesn't work of dos, slatex on dos
% will use a different character, and make the
% redefinition available through the following
\inputifpossible{xZfilhid.tex}
% @ is no longer a letter for TeX
\ifusinglatex\relax\else
\catcode`@\atcatcodebeforeslatex
\fi
\message{*** Check: Are you sure you called SLaTeX? ***}

1658
benchmarks/rnrs-benchmarks/slatex-data/test.tex Normal file
View File

File diff suppressed because it is too large Load Diff

2
benchmarks/rnrs-benchmarks/slatex.ss
View File

@ -10,7 +10,7 @@
(rnrs)
(rnrs unicode)
(rnrs mutable-pairs)
(rnrs i/o simple)
(rnrs io simple)
(rnrs-benchmarks))
(define *op-sys* 'unix)