Changeset 14641 in project


Ignore:
Timestamp:
05/15/09 04:02:33 (10 years ago)
Author:
Ivan Raikov
Message:

matrix-utils ported to Chicken 4

Location:
release/4
Files:
12 deleted
5 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/matrix-utils/trunk/matrix-utils-eggdoc.scm

    r7358 r14641  
    1010     (name "matrix-utils")
    1111     (description "Generation of special utility matrices that are represented as SRFI-4 vectors.")
    12      (author (url "http://chicken.wiki.br/ivan raikov" "Ivan Raikov"))
     12     (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov"))
    1313
    1414     (history
     15      (version "1.10" "Ported to Chicken 4")
    1516      (version "1.9" "Build script updated for better cross-platform compatibility")
    1617      (version "1.8" "Added procedure make-matrix-map")
     
    275276
    276277     (license
    277 "Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     278"Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of Science and Technology.
    278279
    279280This program is free software: you can redistribute it and/or modify
  • release/4/matrix-utils/trunk/matrix-utils.meta

    r9305 r14641  
     1;;;; -*- Hen -*-
     2
    13((egg "matrix-utils.egg") ; This should never change
    24
    35 ; List here all the files that should be bundled as part of your egg. 
    46
    5  (files "matrix-utils.scm" "matrix-utils-eggdoc.scm" "matrix-utils-support.scm" "matrix-utils.setup" )
     7 (files "matrix-utils.scm" "matrix-utils-eggdoc.scm" "matrix-utils.setup" )
    68
    79 ; Your egg's license:
     
    1618 ; A list of eggs matrix-utils depends on.
    1719
    18  (needs syntax-case blas srfi-42 srfi-4-comprehensions eggdoc)
     20 (needs eggdoc srfi-42 srfi-4-comprehensions blas)
    1921
    2022 (eggdoc "matrix-utils-eggdoc.scm")
  • release/4/matrix-utils/trunk/matrix-utils.scm

    r6046 r14641  
    44;;
    55;;
    6 ;; Copyright 2007 Ivan Raikov and the Okinawa Institute of Science and Technology
     6;; Copyright 2007-2009 Ivan Raikov and the Okinawa Institute of
     7;; Science and Technology.
    78;;
    89;;
     
    2223;;
    2324
    24 (require-extension syntax-case)
    25 (require-extension srfi-4)
    26 (import srfi-4-comprehensions)
    27 (require-extension blas)
    28 (require-extension matrix-utils-support)
    29 
    30 
    31 (define-macro (define-utility-matrices type)
    32   (let ((prims  (case type
    33                   ((f64)    `(list f64vector-ref make-f64vector (make-fill-matrix f64vector-set!)))
    34                   ((f32)    `(list f32vector-ref make-f32vector (make-fill-matrix f32vector-set!)))
    35                   ((s32)    `(list s64vector-ref make-s64vector (make-fill-matrix s64vector-set!)))
    36                   ((u32)    `(list u32vector-ref make-u32vector (make-fill-matrix u32vector-set!)))
    37                   (else     `(if (list? ,type)
    38                                  (list (alist-ref 'vector-ref ,type)
    39                                          (alist-ref 'make-vector ,type)
    40                                          (make-fill-matrix (alist-ref 'vector-set! ,type)))
    41                                  (matrix-utils:error 'define-matrix-type "invalid type " ,type))))))
    42      `(begin
    43         (define matrix-primitives ,prims)
    44         (define fill-matrix! (caddr matrix-primitives))
    45         (define matrix-ones  (make-matrix-ones (cadr matrix-primitives) fill-matrix!))
    46         (define matrix-zeros (make-matrix-zeros (cadr matrix-primitives) fill-matrix!))
    47         (define matrix-eye   (make-matrix-eye (cadr matrix-primitives) fill-matrix!))
    48         (define matrix-diag  (make-matrix-diag (car matrix-primitives) (cadr matrix-primitives) fill-matrix!))
    49         (define linspace (make-linspace (cadr matrix-primitives) fill-matrix!))
    50         (define logspace (make-logspace linspace (car matrix-primitives) (cadr matrix-primitives) fill-matrix!)))))
     25(module matrix-utils
     26
     27                (matrix-utils:error
     28                 make-matrix-map
     29                 make-matrix-fold
     30                 make-matrix-fold-partial
     31                 make-fill-matrix
     32                 make-matrix-ones
     33                 make-matrix-zeros
     34                 make-matrix-eye
     35                 make-matrix-diag
     36                 make-linspace
     37                 make-logspace
     38                 
     39                 define-utility-matrices
     40                 with-utility-matrices)
     41
     42   (import scheme chicken data-structures srfi-4)
     43   (require-extension srfi-4 srfi-42 srfi-4-comprehensions blas)
     44
     45
     46(define (matrix-utils:error x . rest)
     47  (let ((port (open-output-string)))
     48    (let loop ((objs (cons x rest)))
     49      (if (null? objs)
     50          (begin
     51            (newline port)
     52            (error 'matrix-utils (get-output-string port)))
     53          (begin (display (car objs) port)
     54                 (display " " port)
     55                 (loop (cdr objs)))))))
     56
     57;;
     58;; Given a procedure VECTOR-SET! returns a procedure FILL-MATRIX! of
     59;; the form FILL-MATRIX!:: M * N * A * F * F0 * [IX * IY * EX * EY] -> A
     60;;
     61;; Where procedure FILL-MATRIX! fills matrix A of size M x N with the
     62;; values returned by applying procedure F to each pair of indices in
     63;; the matrix.
     64;;
     65;; Procedure F is of the form LAMBDA I J AX -> VAL * AX1, where I and
     66;; J are matrix indices, and AX is accumulator value (like in
     67;; fold). The initial value of AX is given by F0. Procedure F is
     68;; expected to return two values: the value to be placed in matrix A
     69;; at position [I,J], and the new accumulator value (or #f).
     70;;
     71;; Optional arguments IX IY EX EY may specify a sub-matrix in matrix A
     72;; to be filled. These arguments are checked to make sure they specify
     73;; a valid sub-matrix.
     74;;
     75;; VECTOR-SET! is one of the homogeneous vector setting procedure from
     76;; SRFI-4. Procedure F must ensure that it returns values that are
     77;; within the range of the SRFI-4 type used.
     78;;
     79(define (make-fill-matrix vector-set!)
     80  (lambda (order M N A f f0 . rest)
     81    ;; optional arguments to specify a sub-matrix to be filled
     82    (let-optionals rest ((ix 0) (iy 0) (ex M) (ey N))
     83     (if (not (and (fx>= ix 0) (fx>= iy 0) (fx<= ex M) (fx<= ey N)
     84                   (fx<= ix ex) (fx<= iy ey)))
     85         (matrix-utils:error 'fill-matrix! "invalid sub-matrix dimensions: " (list ix iy ex ey)))
     86
     87     (cond ((= order blas:RowMajor)
     88            (fold-ec f0 (:parallel (:range b (fx* N ix) (fx* N M) N) (:range x ix ex)) (cons x b)
     89                     (lambda (x+b ax)
     90                       (fold-ec ax (:range y iy ey) y
     91                                (lambda (y ax)
     92                                  (let ((i (fx- (car x+b) ix)) (j (fx- y iy)))
     93                                    (let-values (((val ax1) (f i j ax)))
     94                                      (vector-set! A (fx+ (cdr x+b) y) val)
     95                                      ax1)))))))
     96           
     97           ((= order blas:ColMajor)
     98            (fold-ec f0 (:parallel (:range b (fx* N ix) (fx* N M) M) (:range y iy ey)) (cons y b)
     99                     (lambda (y+b ax)
     100                       (fold-ec ax (:range x ix ex) x
     101                                (lambda (x ax)
     102                                  (let ((i (fx- x ix)) (j (fx- (car y+b) iy)))
     103                                    (let-values (((val ax1) (f j i ax)))
     104                                      (vector-set! A (fx+ (cdr y+b) x) val)
     105                                      ax1)))))))
     106           
     107           (else (matrix-utils:error 'fill-matrix! "unknown order " order)))
     108     A)))
     109
     110;;
     111;; Given procedures MAKE-VECTOR and FILL-MATRIX!, returns a procedure
     112;; ONES of the form ONES:: M * N [* ORDER] -> A
     113;;
     114;; Where procedure ONES returns a matrix A of size M x N, in which all
     115;; elements are 1.  Optional argument ORDER specifies the matrix
     116;; layout: blas:ColMajor or blas:RowMajor, default is blas:RowMajor.
     117;;
     118;; MAKE-VECTOR is one of the homogeneous vector creation procedures
     119;; from SRFI-4, and FILL-MATRIX! is a procedure created by
     120;; MAKE-FILL-MATRIX, above. FILL-MATRIX! must operate on the same type
     121;; of vector as MAKE-VECTOR.
     122;;
     123(define (make-matrix-ones make-vector fill-matrix!)
     124  (lambda (m n . rest)
     125    (let-optionals rest ((order blas:RowMajor))
     126      (let ((A (make-vector (fx* m n))))
     127        (fill-matrix! order m n A (lambda (i j ax) (values 1.0 #f)) #f)))))
     128
     129;;
     130;; Given procedures MAKE-VECTOR and FILL-MATRIX!, returns a procedure
     131;; ZEROS of the form ZEROS:: M * N [* ORDER] -> A
     132;;
     133;; Where procedure ZEROS returns a matrix A of size M x N, in which all
     134;; elements are 0.  Optional argument ORDER specifies the matrix
     135;; layout: blas:ColMajor or blas:RowMajor, default is blas:RowMajor.
     136;;
     137;; MAKE-VECTOR is one of the homogeneous vector creation procedures
     138;; from SRFI-4, and FILL-MATRIX! is a procedure created by
     139;; MAKE-FILL-MATRIX, above. FILL-MATRIX! must operate on the same type
     140;; of vector as MAKE-VECTOR.
     141;;
     142(define (make-matrix-zeros make-vector fill-matrix!)
     143  (lambda (m n . rest)
     144    (let-optionals rest ((order blas:RowMajor))
     145      (let ((A (make-vector (fx* m n))))
     146        (fill-matrix! order m n A (lambda (i j ax) (values 0.0 #f)) #f)))))
     147
     148
     149;;
     150;; Given procedures MAKE-VECTOR and FILL-MATRIX!, returns a procedure
     151;; EYE of the form EYE:: M * N [* ORDER] -> I
     152;;
     153;; Where procedure EYE returns an identity matrix of size M x N.
     154;; Optional argument ORDER specifies the matrix layout: blas:ColMajor
     155;; or blas:RowMajor, default is blas:RowMajor.
     156;;
     157;; MAKE-VECTOR is one of the homogeneous vector creation procedures
     158;; from SRFI-4, and FILL-MATRIX! is a procedure created by
     159;; MAKE-FILL-MATRIX, above. FILL-MATRIX! must operate on the same type
     160;; of vector as MAKE-VECTOR.
     161;;
     162(define (make-matrix-eye make-vector fill-matrix!)
     163  (lambda (m n . rest)
     164    (let-optionals rest ((order blas:RowMajor))
     165      (let ((A  (make-vector (fx* m n))))
     166        (fill-matrix! order m n A (lambda (i j ax) (values (if (fx= i j) 1.0 0.0) #f)) #f)))))
     167
     168;;
     169;; Given procedures VECTOR-REF, MAKE-VECTOR and FILL-MATRIX!, returns
     170;; a procedure DIAG of the form DIAG:: M * N * V [* K * ORDER] -> D
     171;;
     172;; Where procedure DIAG returns a diagonal matrix D of size M x N,
     173;; with vector V on diagonal K.  Argument K is optional.  If it is
     174;; positive, the vector is placed on the K-th super-diagonal of matrix
     175;; D.  If it is negative, it is placed on the -K-th sub-diagonal of
     176;; matrix D.  The default value of K is 0, and the vector is placed on
     177;; the main diagonal of matrix D. Optional argument ORDER specifies
     178;; the matrix layout: blas:ColMajor or blas:RowMajor, default is
     179;; blas:RowMajor. Vector V is always assumed to be a row vector.
     180;;
     181;; VECTOR-REF and MAKE-VECTOR are two of the homogeneous vector
     182;; procedures from SRFI-4, and FILL-MATRIX! is a procedure created by
     183;; MAKE-FILL-MATRIX, above. FILL-MATRIX! must operate on the same type
     184;; of vector as VECTOR-REF and MAKE-VECTOR.
     185;;
     186(define (make-matrix-diag vector-ref make-vector fill-matrix!)
     187  (lambda (m n v . rest)
     188    (let-optionals rest ((k 0) (order blas:RowMajor))
     189      (let ((A  (make-vector (fx* m n)))
     190            (k (if (eq? order blas:RowMajor) k (- k))))
     191        (fill-matrix! order m n A
     192                      (lambda (i j vi)
     193                        (if (fx= k (fx- j i))
     194                            (values (vector-ref v vi) (fx+ 1 vi))
     195                            (values 0.0 vi)))
     196                      0)))))
     197
     198;;
     199;; Given procedures MAKE-VECTOR and FILL-MATRIX!, returns a procedure
     200;; LINSPACE of the form LINSPACE:: N * BASE * LIMIT -> V
     201;;
     202;; Where LINSPACE returns a row vector with N linearly spaced elements
     203;; between BASE and LIMIT.  The number of elements, N, must be greater
     204;; than 1.  The BASE and LIMIT are always included in the range.  If
     205;; BASE is greater than LIMIT, the elements are stored in decreasing
     206;; order.
     207;;
     208;; MAKE-VECTOR is one of the homogeneous vector creation procedures
     209;; from SRFI-4, and FILL-MATRIX! is a procedure created by
     210;; MAKE-FILL-MATRIX, above. FILL-MATRIX! must operate on the same type
     211;; of vector as MAKE-VECTOR.
     212;;
     213(define (make-linspace make-vector fill-matrix!)
     214  (lambda (n base limit)
     215    (if (not (> n 1))
     216        (matrix-utils:error 'linspace "vector size N must be greater than 1"))
     217    (let ((step  (/ (- limit base) (fx- n 1)))
     218          (a     (make-vector n)))
     219      (fill-matrix! blas:RowMajor 1 n a
     220                    (lambda (i j ax) (values (+ base (* 1.0 j step)) ax))  #f))))
     221     
     222
     223;; Given procedures VECTOR-REF, MAKE-VECTOR and FILL-MATRIX!, returns
     224;; a procedure LOGSPACE of the form LOGSPACE:: N * BASE * LIMIT -> V
     225;;
     226;; Where LOGSPACE returns a row vector with elements that are
     227;; logarithmically spaced from 10^BASE to 10^LIMIT. The number of
     228;; elements, N, must be greater than 1.  The BASE and LIMIT are always
     229;; included in the range.  If BASE is greater than LIMIT, the elements
     230;; are stored in decreasing order.
     231;;
     232;; MAKE-VECTOR is one of the homogeneous vector creation procedures
     233;; from SRFI-4, and FILL-MATRIX! is a procedure created by
     234;; MAKE-FILL-MATRIX, above. FILL-MATRIX! must operate on the same type
     235;; of vector as MAKE-VECTOR.
     236;;
     237(define (make-logspace linspace vector-ref make-vector fill-matrix!)
     238  (lambda (n base limit)
     239    (if (not (> n 1))
     240        (matrix-utils:error 'logspace "vector size N must be greater than 1"))
     241    (let ((step  (/ (- limit base) (fx- n 1)))
     242          (a     (make-vector n))
     243          (b     (linspace n base limit)))
     244      (fill-matrix! blas:RowMajor 1 n a
     245                    (lambda (i j ax)
     246                      (let ((v  (expt 10 (vector-ref b j))))
     247                        (values v  ax))) #f))))
     248
     249
     250
     251;;
     252;; Given a procedure VECTOR-REF returns a procedure FILL-MATRIX! of
     253;; the form MATRIX-FOLD-PARTIAL:: M * N * A * F * P * X0 * [IX * IY * EX * EY] -> XN
     254;;
     255;; Where procedure MATRIX-FOLD-PARTIAL applies the fold operation on a
     256;; matrix A of size M x N with the values returned by applying
     257;; procedure F to each pair of indices and the corresponding value at
     258;; that position in the matrix. MATRIX-FOLD-PARTIAL first applies the
     259;; predicate P to the indices, and if P returns true, then F is
     260;; applied.
     261;;
     262;; Procedure F is of the form LAMBDA V AX -> AX1, where V is a
     263;; matrix element at position (I,J) and AX is accumulator value. The
     264;; initial value of AX is given by X0. Procedure F is expected to
     265;; return the new accumulator value.
     266;;
     267;; Procedure P is of the form LAMBDA I J -> boolean, where I and J are
     268;; matrix indices.
     269;;
     270;; Optional arguments IX IY EX EY may specify a sub-matrix in matrix A
     271;; to be filled. These arguments are checked to make sure they specify
     272;; a valid sub-matrix.
     273;;
     274;; VECTOR-REF is one of the homogeneous vector accessor procedure from
     275;; SRFI-4.
     276;;
     277
     278(define (make-matrix-fold-partial vector-ref)
     279  (lambda (order M N A f p x0 . rest)
     280    ;; optional arguments to specify a sub-matrix
     281    (let-optionals rest ((ix 0) (iy 0) (ex M) (ey N))
     282     (if (not (and (fx>= ix 0) (fx>= iy 0) (fx<= ex M) (fx<= ey N)
     283                   (fx<= ix ex) (fx<= iy ey)))
     284         (matrix-utils:error 'matrix-fold-partial "invalid sub-matrix dimensions: " (list ix iy ex ey)))
     285
     286     (cond ((= order blas:RowMajor)
     287            (fold-ec x0 (:parallel (:range b (fx* N ix) (fx* N M) N) (:range x ix ex)) (cons x b)
     288                     (lambda (x+b ax)
     289                       (fold-ec ax (:range y iy ey) y
     290                                (lambda (y ax)
     291                                  (let ((i (fx- (car x+b) ix)) (j (fx- y iy)))
     292                                    (if (p i j)
     293                                        (f (vector-ref A (fx+ (cdr x+b) y)) ax) ax)))))))
     294           
     295           ((= order blas:ColMajor)
     296            (fold-ec x0 (:parallel (:range b (fx* N ix) (fx* N M) M) (:range y iy ey)) (cons  b)
     297                     (lambda (y+b ax)
     298                       (fold-ec ax (:range x ix ex) x
     299                                (lambda (x ax)
     300                                  (let ((i (fx- x ix)) (j (fx- (car y+b) iy)))
     301                                    (if (p j i)
     302                                        (f (vector-ref A (fx+ (cdr y+b) x)) ax) ax)))))))
     303           
     304           (else (matrix-utils:error 'matrix-fold-partial "unknown order " order))))))
     305     
     306 
     307
     308;;
     309;; Given a procedure VECTOR-REF returns a procedure MATRIX-FOLD of
     310;; the form MATRIX-FOLD:: M * N * A * F * X0 * [IX * IY * EX * EY] -> XN
     311;;
     312;; Where procedure MATRIX-FOLD applies the fold operation on a
     313;; matrix A of size M x N with the values returned by applying
     314;; procedure F to each pair of indices and the corresponding value at
     315;; that position in the matrix.
     316;;
     317;; Procedure F is of the form LAMBDA I J V AX -> AX1, where V is a
     318;; matrix element at position (I,J) and AX is accumulator value. The
     319;; initial value of AX is given by X0. Procedure F is expected to
     320;; return the new accumulator value.
     321;;
     322;; Optional arguments IX IY EX EY may specify a sub-matrix in matrix A
     323;; to be filled. These arguments are checked to make sure they specify
     324;; a valid sub-matrix.
     325;;
     326;; VECTOR-REF is one of the homogeneous vector accessor procedure from
     327;; SRFI-4.
     328;;
     329
     330(define (make-matrix-fold vector-ref)
     331  (lambda (order M N A f x0 . rest)
     332    ;; optional arguments to specify a sub-matrix
     333    (let-optionals rest ((ix 0) (iy 0) (ex M) (ey N))
     334     (if (not (and (fx>= ix 0) (fx>= iy 0) (fx<= ex M) (fx<= ey N)
     335                   (fx<= ix ex) (fx<= iy ey)))
     336         (matrix-utils:error 'matrix-fold "invalid sub-matrix dimensions: " (list ix iy ex ey)))
     337
     338     (cond ((= order blas:RowMajor)
     339            (fold-ec x0 (:parallel (:range b (fx* N ix) (fx* N M) N) (:range x ix ex)) (cons x b)
     340                     (lambda (x+b ax)
     341                       (fold-ec ax (:range y iy ey) y
     342                                (lambda (y ax)
     343                                  (let ((i (fx- (car x+b) ix)) (j (fx- y iy)))
     344                                    (f i j (vector-ref A (fx+ (cdr x+b) y)) ax) ax))))))
     345           
     346           ((= order blas:ColMajor)
     347            (fold-ec x0 (:parallel (:range b (fx* N ix) (fx* N M) M) (:range y iy ey)) (cons  b)
     348                     (lambda (y+b ax)
     349                       (fold-ec ax (:range x ix ex) x
     350                                (lambda (x ax)
     351                                  (let ((i (fx- x ix)) (j (fx- (car y+b) iy)))
     352                                    (f j i (vector-ref A (fx+ (cdr y+b) x)) ax) ax))))))
     353           
     354           (else (matrix-utils:error 'matrix-fold "unknown order " order))))))
     355     
     356
     357 
     358(define (make-matrix-map vector-ref vector-set!)
     359  (define fill-matrix! (make-fill-matrix vector-set!))
     360  (lambda (order M N A f . rest)
     361    ;; optional arguments to specify a sub-matrix to be mapped
     362    (let-optionals rest ((ix 0) (iy 0) (ex M) (ey N))
     363     (if (not (and (fx>= ix 0) (fx>= iy 0) (fx<= ex M) (fx<= ey N)
     364                   (fx<= ix ex) (fx<= iy ey)))
     365         (matrix-utils:error 'matrix-map "invalid sub-matrix dimensions: " (list ix iy ex ey)))
     366     (cond ((= order blas:RowMajor)
     367            (fill-matrix! order M N A (lambda (i j ax)
     368                                        (let ((v  (vector-ref A (fx+ j (fx* i M))))) (values (f i j v) #f))) #f))
     369           ((= order blas:ColMajor)
     370            (fill-matrix! order M N A (lambda (i j ax)
     371                                        (let ((v  (vector-ref A (fx+ i (fx* j N))))) (values (f j i v) #f))) #f))
     372           (else (matrix-utils:error 'matrix-map "unknown order " order))))))
     373                           
     374
     375
     376(define-syntax define-utility-matrices
     377  (lambda (x r c)
     378    (let* ((type (cadr x))
     379           (prims  (case type
     380                     ((f64)    `(list f64vector-ref make-f64vector (make-fill-matrix f64vector-set!)))
     381                     ((f32)    `(list f32vector-ref make-f32vector (make-fill-matrix f32vector-set!)))
     382                     ((s32)    `(list s64vector-ref make-s64vector (make-fill-matrix s64vector-set!)))
     383                     ((u32)    `(list u32vector-ref make-u32vector (make-fill-matrix u32vector-set!)))
     384                     (else     `(if (list? ,type)
     385                                    (list (alist-ref 'vector-ref ,type)
     386                                          (alist-ref 'make-vector ,type)
     387                                          (make-fill-matrix (alist-ref 'vector-set! ,type)))
     388                                    (matrix-utils:error 'define-matrix-type "invalid type " ,type)))))
     389           (%begin  (r 'begin))
     390           (%define (r 'define)))
     391
     392     `(,%begin
     393        (,%define matrix-primitives ,prims)
     394        (,%define fill-matrix! (caddr matrix-primitives))
     395        (,%define matrix-ones  (make-matrix-ones (cadr matrix-primitives) fill-matrix!))
     396        (,%define matrix-zeros (make-matrix-zeros (cadr matrix-primitives) fill-matrix!))
     397        (,%define matrix-eye   (make-matrix-eye (cadr matrix-primitives) fill-matrix!))
     398        (,%define matrix-diag  (make-matrix-diag (car matrix-primitives) (cadr matrix-primitives) fill-matrix!))
     399        (,%define linspace (make-linspace (cadr matrix-primitives) fill-matrix!))
     400        (,%define logspace (make-logspace linspace (car matrix-primitives) (cadr matrix-primitives) fill-matrix!)))))
     401  )
    51402       
    52403
    53 (define-macro (with-utility-matrices type expr)
    54   (let ((prims  (case type
    55                   ((f64)    `(list f64vector-ref make-f64vector (make-fill-matrix f64vector-set!)))
    56                   ((f32)    `(list f32vector-ref make-f32vector (make-fill-matrix f32vector-set!)))
    57                   ((s32)    `(list s64vector-ref make-s64vector (make-fill-matrix s64vector-set!)))
    58                   ((u32)    `(list u32vector-ref make-u32vector (make-fill-matrix u32vector-set!)))
    59                   (else     `(if (list? ,type)
    60                                  (list (alist-ref 'vector-ref ,type)
    61                                          (alist-ref 'make-vector ,type)
    62                                          (make-fill-matrix (alist-ref 'vector-set! ,type)))
    63                                  (matrix-utils:error 'define-matrix-type "invalid type " ,type))))))
    64      `(let* ((matrix-primitives ,prims)
    65              (fill-matrix! (caddr matrix-primitives))
    66              (matrix-ones  (make-matrix-ones (cadr matrix-primitives) fill-matrix!))
    67              (matrix-zeros (make-matrix-zeros (cadr matrix-primitives) fill-matrix!))
    68              (matrix-eye   (make-matrix-eye (cadr matrix-primitives) fill-matrix!))
    69              (matrix-diag  (make-matrix-diag (car matrix-primitives) (cadr matrix-primitives) fill-matrix!))
    70              (linspace (make-linspace (cadr matrix-primitives) fill-matrix!))
    71              (logspace (make-logspace linspace (car matrix-primitives) (cadr matrix-primitives) fill-matrix!)))
    72         ,expr)))
    73 
     404(define-syntax with-utility-matrices
     405  (lambda (x r c)
     406    (let* ((type (cadr x))
     407           (expr (caddr x))
     408           (prims  (case type
     409                     ((f64)    `(list f64vector-ref make-f64vector (make-fill-matrix f64vector-set!)))
     410                     ((f32)    `(list f32vector-ref make-f32vector (make-fill-matrix f32vector-set!)))
     411                     ((s32)    `(list s64vector-ref make-s64vector (make-fill-matrix s64vector-set!)))
     412                     ((u32)    `(list u32vector-ref make-u32vector (make-fill-matrix u32vector-set!)))
     413                     (else     `(if (list? ,type)
     414                                    (list (alist-ref 'vector-ref ,type)
     415                                          (alist-ref 'make-vector ,type)
     416                                          (make-fill-matrix (alist-ref 'vector-set! ,type)))
     417                                    (matrix-utils:error 'define-matrix-type "invalid type " ,type)))))
     418           (%let* (r 'let*)))
     419     `(,%let* ((matrix-primitives ,prims)
     420               (fill-matrix! (caddr matrix-primitives))
     421               (matrix-ones  (make-matrix-ones (cadr matrix-primitives) fill-matrix!))
     422               (matrix-zeros (make-matrix-zeros (cadr matrix-primitives) fill-matrix!))
     423               (matrix-eye   (make-matrix-eye (cadr matrix-primitives) fill-matrix!))
     424               (matrix-diag  (make-matrix-diag (car matrix-primitives) (cadr matrix-primitives) fill-matrix!))
     425               (linspace (make-linspace (cadr matrix-primitives) fill-matrix!))
     426               (logspace (make-logspace linspace (car matrix-primitives) (cadr matrix-primitives) fill-matrix!)))
     427              ,expr)))
     428  )
     429
     430)
    74431       
    75432
  • release/4/matrix-utils/trunk/matrix-utils.setup

    r6616 r14641  
    1 
    2 (define has-exports? (string>=? (chicken-version) "2.310"))
     1;;;; -*- Hen -*-
    32
    43(define (dynld-name fn)         
    54  (make-pathname #f fn ##sys#load-dynamic-extension))   
    65
    7 (compile -O2 -d0 -o ,(dynld-name "matrix-utils-support") -s
    8          ,@(if has-exports? '(-check-imports -emit-exports matrix-utils-support.exports) '())
    9          matrix-utils-support.scm)
     6(compile -O2 -d0 -s matrix-utils.scm -j matrix-utils)
     7(compile -O2 -d0 -s matrix-utils.import.scm)
     8
    109
    1110(run (csi -qbs matrix-utils-eggdoc.scm > matrix-utils.html))
     
    1312(install-extension
    1413 'matrix-utils
    15  `( ,(dynld-name "matrix-utils-support") "matrix-utils.scm"  "matrix-utils.html"
    16    ,@(if has-exports? '("matrix-utils-support.exports") (list)) )
    17  `((version 1.9)
    18    (syntax)
    19    (require-at-runtime matrix-utils-support)
     14 `( ,(dynld-name "matrix-utils") ,(dynld-name "matrix-utils.import") )
     15 `((version 1.10)
    2016   (documentation "matrix-utils.html")))
     17
  • release/4/neuromorpho/neuromorpho.scm

    r14640 r14641  
    306306                       "make index file"
    307307                       (make-index? #t))
    308     ,(args:make-option (if)       #:none
     308    ,(args:make-option (if)       (required: "FIELD1,...")
    309309                       (string-append "comma-separated list of index fields "
    310310                                      "(default is " (string-intersperse (index-fields) ", ") ")")
    311                        (index-fields (string-split arg ",")))
     311                       (index-fields (string-split (or arg "") ",")))
    312312    ,(args:make-option (h help)  #:none               "Print help"
    313313                       (usage))))
Note: See TracChangeset for help on using the changeset viewer.