Changeset 10047 in project


Ignore:
Timestamp:
03/22/08 16:23:46 (12 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/3/srfi-67/trunk
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/3/srfi-67/trunk/srfi-67.meta

    r10045 r10047  
    88 (license "BSD")
    99 (needs syntax-case numbers utf8 srfi-42)
     10 (doc-from-wiki)
    1011 (files
    1112  "tests"
     
    1314        "srfi-67.html"
    1415        "srfi-67.scm"
     16        "srfi-67-support.scm"
    1517        "srfi-67-aliases.scm"
    1618        "srfi-67.setup"))
  • release/3/srfi-67/trunk/srfi-67.scm

    r10045 r10047  
    11;;;; srfi-67.scm
    22
    3 (eval-when (compile)
    4   (declare
    5     (not usual-integrations
    6       string?
    7       string=? string<?
    8       string-ci=? string=ci<?
    9       number?
    10       integer? real? rational? complex?
    11       = <)
    12     (hide
    13       random-integer
    14       compare:checked) ) )
    15 
    16 (use (srfi 16 23) syntax-case)
    17 
    18 (register-feature! 'srfi-67)
    19 
    20 ; SRFI 27
    21 (define random-integer random)
     3(use (srfi 23) syntax-case)
    224
    235; Copyright (c) 2005 Sebastian Egner and Jens Axel S{\o}gaard.
     
    10486;     the arguments.
    10587
    106 (define (compare:checked result compare . args)
    107   (for-each (lambda (x) (compare x x)) args)
    108   result)
    109 
    11088
    11189; 3-sided conditional
     
    163141     (compare:if-rel? (-1 1) (0) arg ...))))
    164142
    165 
    166 ; predicates from compare procedures
    167 
    168 (define-syntax compare:define-rel?
    169   (syntax-rules ()
    170     ((compare:define-rel? rel? if-rel?)
    171      (define rel?
    172        (case-lambda
    173         (()        (lambda (x y) (if-rel? (default-compare x y) #t #f)))
    174         ((compare) (lambda (x y) (if-rel? (compare         x y) #t #f)))
    175         ((x y)                   (if-rel? (default-compare x y) #t #f))
    176         ((compare x y)
    177          (if (procedure? compare)
    178              (if-rel? (compare x y) #t #f)
    179              (error "not a procedure (Did you mean rel/rel??): " compare))))))))
    180 
    181 (compare:define-rel? =?    if=?)
    182 (compare:define-rel? <?    if<?)
    183 (compare:define-rel? >?    if>?)
    184 (compare:define-rel? <=?   if<=?)
    185 (compare:define-rel? >=?   if>=?)
    186 (compare:define-rel? not=? if-not=?)
    187 
    188 
    189 ; chains of length 3
    190 
    191 (define-syntax compare:define-rel1/rel2?
    192   (syntax-rules ()
    193     ((compare:define-rel1/rel2? rel1/rel2? if-rel1? if-rel2?)
    194      (define rel1/rel2?
    195        (case-lambda
    196         (()
    197          (lambda (x y z)
    198            (if-rel1? (default-compare x y)
    199                      (if-rel2? (default-compare y z) #t #f)
    200                      (compare:checked #f default-compare z))))
    201         ((compare)
    202          (lambda (x y z)
    203            (if-rel1? (compare x y)
    204                 (if-rel2? (compare y z) #t #f)
    205                 (compare:checked #f compare z))))
    206         ((x y z)
    207          (if-rel1? (default-compare x y)
    208                (if-rel2? (default-compare y z) #t #f)
    209                (compare:checked #f default-compare z)))
    210         ((compare x y z)
    211          (if-rel1? (compare x y)
    212                (if-rel2? (compare y z) #t #f)
    213                (compare:checked #f compare z))))))))
    214 
    215 (compare:define-rel1/rel2? </<?   if<?  if<?)
    216 (compare:define-rel1/rel2? </<=?  if<?  if<=?)
    217 (compare:define-rel1/rel2? <=/<?  if<=? if<?)
    218 (compare:define-rel1/rel2? <=/<=? if<=? if<=?)
    219 (compare:define-rel1/rel2? >/>?   if>?  if>?)
    220 (compare:define-rel1/rel2? >/>=?  if>?  if>=?)
    221 (compare:define-rel1/rel2? >=/>?  if>=? if>?)
    222 (compare:define-rel1/rel2? >=/>=? if>=? if>=?)
    223 
    224 
    225 ; chains of arbitrary length
    226 
    227 (define-syntax compare:define-chain-rel?
    228   (syntax-rules ()
    229     ((compare:define-chain-rel? chain-rel? if-rel?)
    230      (define chain-rel?
    231        (case-lambda
    232         ((compare)
    233          #t)
    234         ((compare x1)
    235          (compare:checked #t compare x1))
    236         ((compare x1 x2)
    237          (if-rel? (compare x1 x2) #t #f))
    238         ((compare x1 x2 x3)
    239          (if-rel? (compare x1 x2)
    240                   (if-rel? (compare x2 x3) #t #f)
    241                   (compare:checked #f compare x3)))
    242         ((compare x1 x2 . x3+)
    243          (if-rel? (compare x1 x2)
    244                   (let chain? ((head x2) (tail x3+))
    245                     (if (null? tail)
    246                         #t
    247                         (if-rel? (compare head (car tail))
    248                                  (chain? (car tail) (cdr tail))
    249                                  (apply compare:checked #f
    250                                         compare (cdr tail)))))
    251                   (apply compare:checked #f compare x3+))))))))
    252 
    253 (compare:define-chain-rel? chain=?  if=?)
    254 (compare:define-chain-rel? chain<?  if<?)
    255 (compare:define-chain-rel? chain>?  if>?)
    256 (compare:define-chain-rel? chain<=? if<=?)
    257 (compare:define-chain-rel? chain>=? if>=?)
    258 
    259 
    260 ; pairwise inequality
    261 
    262 (define pairwise-not=?
    263   (let ((= =) (<= <=))
    264     (case-lambda
    265       ((compare)
    266        #t)
    267       ((compare x1)
    268        (compare:checked #t compare x1))
    269       ((compare x1 x2)
    270        (if-not=? (compare x1 x2) #t #f))
    271       ((compare x1 x2 x3)
    272        (if-not=? (compare x1 x2)
    273                  (if-not=? (compare x2 x3)
    274                            (if-not=? (compare x1 x3) #t #f)
    275                            #f)
    276                  (compare:checked #f compare x3)))
    277       ((compare . x1+)
    278        (let unequal? ((x x1+) (n (length x1+)) (unchecked? #t))
    279          (if (fx< n 2)
    280              (if (and unchecked? (fx= n 1))
    281                  (compare:checked #t compare (car x))
    282                  #t)
    283              (let* ((i-pivot (random-integer n))
    284                     (x-pivot (list-ref x i-pivot)))
    285                (let split ((i 0) (x x) (x< '()) (x> '()))
    286                  (if (null? x)
    287                      (and (unequal? x< (length x<) #f)
    288                           (unequal? x> (length x>) #f))
    289                      (if (fx= i i-pivot)
    290                          (split (fx+ i 1) (cdr x) x< x>)
    291                          (if3 (compare (car x) x-pivot)
    292                               (split (fx+ i 1) (cdr x) (cons (car x) x<) x>)
    293                               (if unchecked?
    294                                   (apply compare:checked #f compare (cdr x))
    295                                   #f)
    296                               (split (fx+ i 1) (cdr x) x< (cons (car x) x>)))))))))))))
    297 
    298 
    299 ; min/max
    300 
    301 (define min-compare
    302   (case-lambda
    303     ((compare x1)
    304      (compare:checked x1 compare x1))
    305     ((compare x1 x2)
    306      (if<=? (compare x1 x2) x1 x2))
    307     ((compare x1 x2 x3)
    308      (if<=? (compare x1 x2)
    309             (if<=? (compare x1 x3) x1 x3)
    310             (if<=? (compare x2 x3) x2 x3)))
    311     ((compare x1 x2 x3 x4)
    312      (if<=? (compare x1 x2)
    313             (if<=? (compare x1 x3)
    314                    (if<=? (compare x1 x4) x1 x4)
    315                    (if<=? (compare x3 x4) x3 x4))
    316             (if<=? (compare x2 x3)
    317                    (if<=? (compare x2 x4) x2 x4)
    318                    (if<=? (compare x3 x4) x3 x4))))
    319     ((compare x1 x2 . x3+)
    320      (let min ((xmin (if<=? (compare x1 x2) x1 x2)) (xs x3+))
    321        (if (null? xs)
    322            xmin
    323            (min (if<=? (compare xmin (car xs)) xmin (car xs))
    324                 (cdr xs)))))))
    325 
    326 (define max-compare
    327   (case-lambda
    328     ((compare x1)
    329      (compare:checked x1 compare x1))
    330     ((compare x1 x2)
    331      (if>=? (compare x1 x2) x1 x2))
    332     ((compare x1 x2 x3)
    333      (if>=? (compare x1 x2)
    334             (if>=? (compare x1 x3) x1 x3)
    335             (if>=? (compare x2 x3) x2 x3)))
    336     ((compare x1 x2 x3 x4)
    337      (if>=? (compare x1 x2)
    338             (if>=? (compare x1 x3)
    339                    (if>=? (compare x1 x4) x1 x4)
    340                    (if>=? (compare x3 x4) x3 x4))
    341             (if>=? (compare x2 x3)
    342                    (if>=? (compare x2 x4) x2 x4)
    343                    (if>=? (compare x3 x4) x3 x4))))
    344     ((compare x1 x2 . x3+)
    345      (let max ((xmax (if>=? (compare x1 x2) x1 x2)) (xs x3+))
    346        (if (null? xs)
    347            xmax
    348            (max (if>=? (compare xmax (car xs)) xmax (car xs))
    349                 (cdr xs)))))))
    350 
    351 
    352 ; kth-largest
    353 
    354 (define kth-largest
    355   (let ((= =) (< <))
    356     (case-lambda
    357       ((compare k x0)
    358         (unless (fixnum? k) (error "bad index" k))
    359       (case (fxmod k 1)
    360          ((0)  (compare:checked x0 compare x0))
    361          (else (error "bad index" k))))
    362       ((compare k x0 x1)
    363        (unless (fixnum? k) (error "bad index" k))
    364        (case (fxmod k 2)
    365          ((0) (if<=? (compare x0 x1) x0 x1))
    366          ((1) (if<=? (compare x0 x1) x1 x0))
    367          (else (error "bad index" k))))
    368       ((compare k x0 x1 x2)
    369        (unless (fixnum? k) (error "bad index" k))
    370        (case (fxmod k 3)
    371          ((0) (if<=? (compare x0 x1)
    372                      (if<=? (compare x0 x2) x0 x2)
    373                      (if<=? (compare x1 x2) x1 x2)))
    374          ((1) (if3 (compare x0 x1)
    375                    (if<=? (compare x1 x2)
    376                           x1
    377                           (if<=? (compare x0 x2) x2 x0))
    378                    (if<=? (compare x0 x2) x1 x0)
    379                    (if<=? (compare x0 x2)
    380                           x0
    381                           (if<=? (compare x1 x2) x2 x1))))
    382          ((2) (if<=? (compare x0 x1)
    383                      (if<=? (compare x1 x2) x2 x1)
    384                      (if<=? (compare x0 x2) x2 x0)))
    385          (else (error "bad index" k))))
    386       ((compare k x0 . x1+) ; |x1+| >= 1
    387        (unless (fixnum? k) (error "bad index" k))
    388        (let ((n (fx+ 1 (length x1+))))
    389          (let kth ((k   (fxmod k n))
    390                    (n   n)  ; = |x|
    391                    (rev #t) ; are x<, x=, x> reversed?
    392                    (x   (cons x0 x1+)))
    393            (let ((pivot (list-ref x (random-integer n))))
    394              (let split ((x x) (x< '()) (n< 0) (x= '()) (n= 0) (x> '()) (n> 0))
    395                (if (null? x)
    396                    (cond
    397                      ((fx< k n<)
    398                       (kth k n< (not rev) x<))
    399                      ((fx< k (fx+ n< n=))
    400                       (if rev
    401                           (list-ref x= (fx- (fx- n= 1) (fx- k n<)))
    402                           (list-ref x= (fx- k n<))))
    403                      (else
    404                       (kth (fx- k (fx+ n< n=)) n> (not rev) x>)))
    405                    (if3 (compare (car x) pivot)
    406                         (split (cdr x) (cons (car x) x<) (fx+ n< 1) x= n= x> n>)
    407                         (split (cdr x) x< n< (cons (car x) x=) (fx+ n= 1) x> n>)
    408                         (split (cdr x) x< n< x= n= (cons (car x) x>) (fx+ n> 1))))))))))))
    409 
    410 
    411 ; compare functions from predicates
    412 
    413 (define compare-by<
    414   (case-lambda
    415    ((lt)     (lambda (x y) (if (lt x y) -1 (if (lt y x)  1 0))))
    416    ((lt x y)               (if (lt x y) -1 (if (lt y x)  1 0)))))
    417 
    418 (define compare-by>
    419   (case-lambda
    420    ((gt)     (lambda (x y) (if (gt x y) 1 (if (gt y x)  -1 0))))
    421    ((gt x y)               (if (gt x y) 1 (if (gt y x)  -1 0)))))
    422 
    423 (define compare-by<=
    424   (case-lambda
    425    ((le)     (lambda (x y) (if (le x y) (if (le y x) 0 -1) 1)))
    426    ((le x y)               (if (le x y) (if (le y x) 0 -1) 1))))
    427 
    428 (define compare-by>=
    429   (case-lambda
    430    ((ge)     (lambda (x y) (if (ge x y) (if (ge y x) 0 1) -1)))
    431    ((ge x y)               (if (ge x y) (if (ge y x) 0 1) -1))))
    432 
    433 (define compare-by=/<
    434   (case-lambda
    435    ((eq lt)     (lambda (x y) (if (eq x y) 0 (if (lt x y) -1 1))))
    436    ((eq lt x y)               (if (eq x y) 0 (if (lt x y) -1 1)))))
    437 
    438 (define compare-by=/>
    439   (case-lambda
    440    ((eq gt)     (lambda (x y) (if (eq x y) 0 (if (gt x y) 1 -1))))
    441    ((eq gt x y)               (if (eq x y) 0 (if (gt x y) 1 -1)))))
    442 
    443143; refine and extend construction
    444144
     
    480180           (if ty-val (refine-compare cs ...) -1)
    481181           (if ty-val 1 (cond-compare clause ...)))))))
    482 
    483 
    484 ; R5RS atomic types
    485 
    486 (define-syntax compare:type-check
    487   (syntax-rules ()
    488     ((compare:type-check type? type-name x)
    489      (if (not (type? x))
    490          (error (string-append "not " type-name ":") x)))
    491     ((compare:type-check type? type-name x y)
    492      (begin (compare:type-check type? type-name x)
    493             (compare:type-check type? type-name y)))))
    494 
    495 (define-syntax compare:define-by=/<
    496   (syntax-rules ()
    497     ((compare:define-by=/< compare = < type? type-name)
    498      (define compare
    499        (let ((= =) (< <))
    500          (lambda (x y)
    501            (if (type? x)
    502                (if (eq? x y)
    503                    0
    504                    (if (type? y)
    505                        (if (= x y) 0 (if (< x y) -1 1))
    506                        (error (string-append "not " type-name ":") y)))
    507                (error (string-append "not " type-name ":") x))))))))
    508 
    509 (define (boolean-compare x y)
    510   (compare:type-check boolean? "boolean" x y)
    511   (if x (if y 0 1) (if y -1 0)))
    512 
    513 (compare:define-by=/< char-compare char=? char<? char? "char")
    514 
    515 (compare:define-by=/< char-compare-ci char-ci=? char-ci<? char? "char")
    516 
    517 (compare:define-by=/< string-compare string=? string<? string? "string")
    518 
    519 (compare:define-by=/< string-compare-ci string-ci=? string-ci<? string? "string")
    520 
    521 (define (symbol-compare x y)
    522   (compare:type-check symbol? "symbol" x y)
    523   (string-compare (symbol->string x) (symbol->string y)))
    524 
    525 (compare:define-by=/< integer-compare = < integer? "integer")
    526 
    527 (compare:define-by=/< rational-compare = < rational? "rational")
    528 
    529 (compare:define-by=/< real-compare = < real? "real")
    530 
    531 (define (complex-compare x y)
    532   (compare:type-check complex? "complex" x y)
    533   (if (and (real? x) (real? y))
    534       (real-compare x y)
    535       (refine-compare (real-compare (real-part x) (real-part y))
    536                       (real-compare (imag-part x) (imag-part y)))))
    537 
    538 (define (number-compare x y)
    539   (compare:type-check number? "number" x y)
    540   (complex-compare x y))
    541 
    542 
    543 ; R5RS compound data structures: dotted pair, list, vector
    544 
    545 (define (pair-compare-car compare)
    546   (lambda (x y)
    547     (compare (car x) (car y))))
    548 
    549 (define (pair-compare-cdr compare)
    550   (lambda (x y)
    551     (compare (cdr x) (cdr y))))
    552 
    553 (define pair-compare
    554   (case-lambda
    555    
    556     ; dotted pair
    557     ((pair-compare-car pair-compare-cdr x y)
    558      (refine-compare (pair-compare-car (car x) (car y))
    559                      (pair-compare-cdr (cdr x) (cdr y))))
    560    
    561     ; possibly improper lists
    562     ((compare x y)
    563      (cond-compare
    564       (((null? x) (null? y)) 0)
    565       (((pair? x) (pair? y)) (compare              (car x) (car y))
    566                              (pair-compare compare (cdr x) (cdr y)))
    567       (else                  (compare x y))))
    568    
    569     ; for convenience
    570     ((x y)
    571      (pair-compare default-compare x y))))
    572 
    573 (define list-compare
    574   (case-lambda
    575     ((compare x y empty? head tail)
    576      (cond-compare
    577       (((empty? x) (empty? y)) 0)
    578       (else (compare              (head x) (head y))
    579             (list-compare compare (tail x) (tail y) empty? head tail))))
    580    
    581     ; for convenience
    582     ((        x y empty? head tail)
    583      (list-compare default-compare x y empty? head tail))
    584     ((compare x y              )
    585      (list-compare compare         x y null? car   cdr))
    586     ((        x y              )
    587      (list-compare default-compare x y null? car   cdr))))
    588 
    589 (define list-compare-as-vector
    590   (case-lambda
    591     ((compare x y empty? head tail)
    592      (refine-compare
    593       (let compare-length ((x x) (y y))
    594         (cond-compare
    595          (((empty? x) (empty? y)) 0)
    596          (else (compare-length (tail x) (tail y)))))
    597       (list-compare compare x y empty? head tail)))
    598    
    599     ; for convenience
    600     ((        x y empty? head tail)
    601      (list-compare-as-vector default-compare x y empty? head tail))
    602     ((compare x y              )
    603      (list-compare-as-vector compare         x y null?  car  cdr))
    604     ((        x y              )
    605      (list-compare-as-vector default-compare x y null?  car  cdr))))
    606 
    607 (define vector-compare
    608   (let ((= =))
    609     (case-lambda
    610       ((compare x y size ref)
    611        (let ((n (size x)) (m (size y)))
    612          (refine-compare
    613           (integer-compare n m)
    614           (let compare-rest ((i 0)) ; compare x[i..n-1] y[i..n-1]
    615             (if (fx= i n)
    616                 0
    617                 (refine-compare (compare (ref x i) (ref y i))
    618                                 (compare-rest (fx+ i 1))))))))
    619      
    620       ; for convenience
    621       ((        x y size ref)
    622        (vector-compare default-compare x y size          ref))
    623       ((compare x y           )
    624        (vector-compare compare         x y vector-length vector-ref))
    625       ((        x y           )
    626        (vector-compare default-compare x y vector-length vector-ref)))))
    627 
    628 (define vector-compare-as-list
    629   (let ((= =))
    630     (case-lambda
    631       ((compare x y size ref)
    632        (let ((nx (size x)) (ny (size y)))
    633          (let ((n (min nx ny)))
    634            (let compare-rest ((i 0)) ; compare x[i..n-1] y[i..n-1]
    635              (if (fx= i n)
    636                  (integer-compare nx ny)
    637                  (refine-compare (compare (ref x i) (ref y i))
    638                                  (compare-rest (fx+ i 1))))))))
    639      
    640       ; for convenience
    641       ((        x y size ref)
    642        (vector-compare-as-list default-compare x y size          ref))
    643       ((compare x y           )
    644        (vector-compare-as-list compare         x y vector-length vector-ref))
    645       ((        x y           )
    646        (vector-compare-as-list default-compare x y vector-length vector-ref)))))
    647 
    648 
    649 ; default compare
    650 
    651 (define (default-compare x y)
    652   (select-compare
    653    x y
    654    (null?    0)
    655    (pair?    (default-compare (car x) (car y))
    656              (default-compare (cdr x) (cdr y)))
    657    (boolean? (boolean-compare x y))
    658    (char?    (char-compare    x y))
    659    (string?  (string-compare  x y))
    660    (symbol?  (symbol-compare  x y))
    661    (number?  (number-compare  x y))
    662    (vector?  (vector-compare default-compare x y))
    663    (else (error "unrecognized type in default-compare" x y))))
    664 
    665 ; Note that we pass default-compare to compare-{pair,vector} explictly.
    666 ; This makes sure recursion proceeds with this default-compare, which
    667 ; need not be the one in the lexical scope of compare-{pair,vector}.
    668 
    669 
    670 ; debug compare
    671 
    672 (define (debug-compare c)
    673  
    674   (define (checked-value c x y)
    675     (let ((c-xy (c x y)))
    676       (if (or (eqv? c-xy -1) (eqv? c-xy 0) (eqv? c-xy 1))
    677           c-xy
    678           (error "compare value not in {-1,0,1}" c-xy (list c x y)))))
    679  
    680   (define (random-boolean)
    681     (zero? (random-integer 2)))
    682  
    683   (define q ; (u v w) such that u <= v, v <= w, and not u <= w
    684     '#(
    685        ;x < y   x = y   x > y   [x < z]
    686        0       0       0    ; y < z
    687                0    (z y x) (z y x) ; y = z
    688                0    (z y x) (z y x) ; y > z
    689                
    690                ;x < y   x = y   x > y   [x = z]
    691                (y z x) (z x y)    0    ; y < z
    692                (y z x)    0    (x z y) ; y = z
    693                0    (y x z) (x z y) ; y > z
    694                
    695                ;x < y   x = y   x > y   [x > z]
    696                (x y z) (x y z)    0    ; y < z
    697                (x y z) (x y z)    0    ; y = z
    698                0       0       0    ; y > z
    699                ))
    700  
    701   (let ((z? #f) (z #f)) ; stored element from previous call
    702     (lambda (x y)
    703       (let ((c-xx (checked-value c x x))
    704             (c-yy (checked-value c y y))
    705             (c-xy (checked-value c x y))
    706             (c-yx (checked-value c y x)))
    707         (if (not (zero? c-xx))
    708             (error "compare error: not reflexive" c x))
    709         (if (not (zero? c-yy))
    710             (error "compare error: not reflexive" c y))
    711         (if (not (zero? (fx+ c-xy c-yx)))
    712             (error "compare error: not anti-symmetric" c x y))
    713         (if z?
    714             (let ((c-xz (checked-value c x z))
    715                   (c-zx (checked-value c z x))
    716                   (c-yz (checked-value c y z))
    717                   (c-zy (checked-value c z y)))
    718               (if (not (zero? (fx+ c-xz c-zx)))
    719                   (error "compare error: not anti-symmetric" c x z))
    720               (if (not (zero? (fx+ c-yz c-zy)))
    721                   (error "compare error: not anti-symmetric" c y z))
    722               (let ((ijk (vector-ref q (fx+ c-xy (fx* 3 c-yz) (fx* 9 c-xz) 13))))
    723                 (if (list? ijk)
    724                     (apply error
    725                            "compare error: not transitive"
    726                            c
    727                            (map (lambda (i) (case i ((x) x) ((y) y) ((z) z)))
    728                                 ijk)))))
    729             (set! z? #t))
    730         (set! z (if (random-boolean) x y)) ; randomized testing
    731         c-xy))))
  • release/3/srfi-67/trunk/srfi-67.setup

    r10045 r10047  
    11(include "setup-header")
    22
    3 (install-dynld+docu srfi-67 *version*)
     3(install-dynld+syntax+docu srfi-67 srfi-67-support *version*)
  • release/3/srfi-67/trunk/tests/run.scm

    r10044 r10047  
    5454(define (pm-real-part z)            (if (pm-complex? z) (cadr z) z))
    5555(define (pm-imag-part z)            (if (pm-complex? z) (caddr z) z))
     56|#
    5657
    5758; apply on truncated argument list
     
    7778                          (reverse rev-args)
    7879                          (truncate (+ n 1) (cons (car xs) rev-args) (cdr xs)))))))))))
    79 |#
    8080
    8181; =============================================================================
     
    131131(define random-integer random)
    132132(define pretty-write pretty-print)
     133(define apply (make-apply 1024))
    133134
    134135; =============================================================================
Note: See TracChangeset for help on using the changeset viewer.