Changeset 16040 in project


Ignore:
Timestamp:
09/23/09 03:58:30 (10 years ago)
Author:
Kon Lovett
Message:

Use of numbers in -math. Rmvd $$ from macros

Location:
release/4/srfi-41/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-41/trunk/srfi-41.setup

    r16018 r16040  
    2424(setup-shared-extension-module 'streams-math (extension-version "1.0.0")
    2525  #:compile-options '(-optimize-level 3 -inline-limit 50
    26                       -no-procedure-checks))
     26                      -no-procedure-checks
     27                      -require-extension numbers))
    2728
    2829(install-extension 'srfi-41 '() `((version ,(extension-version "1.0.0"))))
  • release/4/srfi-41/trunk/streams-derived.scm

    r16018 r16040  
    1919  ;; SRFI 41 derived
    2020  define-stream stream stream-let
    21   stream-match ;($$stream-match-test)
     21  stream-match
    2222  stream-of
    2323  stream-constant
     
    3636  stream-zip
    3737  ;; WTF
    38   $$stream-match-test ;($$stream-match-pattern)
    39   $$stream-match-pattern)
     38  stream-match-test
     39  stream-match-pattern)
    4040
    4141  (import scheme chicken
     
    6464(define-syntax stream
    6565  (syntax-rules ()
    66     ((stream) stream-null)
     66    ((stream)         stream-null)
    6767    ((stream X Y ...) (stream-cons X (stream Y ...)) ) ) )
    6868
     
    7171    ((stream-let TAG ((NAME VAL) ...) BODY0 BODY1 ...)
    7272     ((letrec ((TAG (stream-lambda (NAME ...) BODY0 BODY1 ...))) TAG) VAL ...) ) ) )
    73 
    74 ;FIXME - this forces use of `_' identifier
    75 (define-syntax $$stream-match-pattern
    76   (syntax-rules (_)
    77 
    78     (($$stream-match-pattern STRM () (BINDING ...) BODY)
    79      (and (stream-null? STRM)
    80           (let (BINDING ...) BODY)) )
    81 
    82     (($$stream-match-pattern STRM (_ . REST) (BINDING ...) BODY)
    83      (and (stream-pair? STRM)
    84           (let ((strm (stream-cdr STRM)))
    85             ($$stream-match-pattern strm REST (BINDING ...) BODY))) )
    86 
    87     (($$stream-match-pattern STRM (VAR . REST) (BINDING ...) BODY)
    88      (and (stream-pair? STRM)
    89           (let ((temp (stream-car STRM))
    90                 (strm (stream-cdr STRM)))
    91             ($$stream-match-pattern strm REST ((VAR temp) BINDING ...) BODY))) )
    92 
    93     (($$stream-match-pattern STRM _ (BINDING ...) BODY)
    94      (let (BINDING ...) BODY) )
    95 
    96     (($$stream-match-pattern STRM VAR (BINDING ...) BODY)
    97      (let ((VAR STRM) BINDING ...) BODY) ) ) )
    98 
    99 (define-syntax $$stream-match-test
    100   (syntax-rules ()
    101 
    102     (($$stream-match-test STRM (PATTERN FENDER EXPR))
    103      ($$stream-match-pattern STRM PATTERN () (and FENDER (list EXPR))) )
    104 
    105     (($$stream-match-test STRM (PATTERN EXPR))
    106      ($$stream-match-pattern STRM PATTERN () (list EXPR)) ) ) )
    10773
    10874(define-syntax stream-match
     
    11177     (let ((strm STRM-EXPR))
    11278       (cond ((not (stream? strm)) (error-stream 'stream-match strm 'stream))
    113              (($$stream-match-test strm CLAUSE) => car) ...
     79             ((stream-match-test strm CLAUSE) => car) ...
    11480             (else (error 'stream-match "no matching pattern")))) ) ) )
     81
     82(define-syntax stream-match-test
     83  (syntax-rules ()
     84
     85    ((stream-match-test STRM (PATTERN FENDER EXPR))
     86     (stream-match-pattern STRM PATTERN () (and FENDER (list EXPR))) )
     87
     88    ((stream-match-test STRM (PATTERN EXPR))
     89     (stream-match-pattern STRM PATTERN () (list EXPR)) ) ) )
     90
     91;FIXME - this forces use of `_' identifier
     92(define-syntax stream-match-pattern
     93  (syntax-rules (_)
     94
     95    ((stream-match-pattern STRM () (BINDING ...) BODY)
     96     (and (stream-null? STRM)
     97          (let (BINDING ...) BODY)) )
     98
     99    ((stream-match-pattern STRM (_ . REST) (BINDING ...) BODY)
     100     (and (stream-pair? STRM)
     101          (let ((strm (stream-cdr STRM)))
     102            (stream-match-pattern strm REST (BINDING ...) BODY))) )
     103
     104    ((stream-match-pattern STRM (VAR . REST) (BINDING ...) BODY)
     105     (and (stream-pair? STRM)
     106          (let ((temp (stream-car STRM))
     107                (strm (stream-cdr STRM)))
     108            (stream-match-pattern strm REST ((VAR temp) BINDING ...) BODY))) )
     109
     110    ((stream-match-pattern STRM _ (BINDING ...) BODY)
     111     (let (BINDING ...) BODY) )
     112
     113    ((stream-match-pattern STRM VAR (BINDING ...) BODY)
     114     (let ((VAR STRM) BINDING ...) BODY) ) ) )
    115115
    116116(define-syntax stream-of
    117117  (syntax-rules (is in)
    118 
     118    ;
    119119    ((stream-of "aux" EXPR BASE)
    120120     (stream-cons EXPR BASE) )
    121 
     121    ;
    122122    ((stream-of "aux" EXPR BASE (VAR in STREAM) REST ...)
    123123     (stream-let loop ((strm STREAM))
     
    125125           (let ((VAR (stream-car strm)))
    126126             (stream-of "aux" EXPR (loop (stream-cdr strm)) REST ...)))) )
    127 
     127    ;
    128128    ((stream-of "aux" EXPR BASE (VAR is EXP) REST ...)
    129129     (let ((VAR EXP)) (stream-of "aux" EXPR BASE REST ...)) )
    130 
     130    ;
    131131    ((stream-of "aux" EXPR BASE PRED? REST ...)
    132132     (if PRED? (stream-of "aux" EXPR BASE REST ...) BASE) )
    133 
     133    ;
    134134    ((stream-of EXPR REST ...)
    135135     (stream-of "aux" EXPR stream-null REST ...) ) ) )
  • release/4/srfi-41/trunk/streams-math.scm

    r16018 r16040  
    3737  (include "streams-inlines")
    3838
    39   #; ;WHAT TO DO ABOUT THE full-numeric-tower!
    4039  (declare
    41     (not usual-integrations < + * max min) )
     40    (not usual-integrations
     41                  + - * / = > < >= <=
     42                  number->string string->number
     43                  eqv? equal?
     44                  exp log sin cos tan atan acos asin expt sqrt
     45                  quotient modulo remainder
     46                  abs max min gcd lcm
     47                  positive? negative? odd? even? zero?
     48                  exact? inexact?
     49                  floor ceiling truncate round
     50                  inexact->exact exact->inexact
     51                  number? complex? real? rational? integer?
     52                  add1 sub1
     53                  bitwise-and bitwise-ior bitwise-xor bitwise-not arithmetic-shift) )
    4254
    4355;;;
Note: See TracChangeset for help on using the changeset viewer.