steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up functors so that the generated code looks sane with 'see'

db4
Slava Pestov 2009-01-28 15:07:16 -06:00
parent f438bd5157
commit 16181f818b
12 changed files with 80 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/functors/functors-tests.factor
View File

@ -34,7 +34,7 @@ WW DEFINES ${W}${W}
WHERE
: WW W twice ; inline
: WW ( a -- b ) \ W twice ; inline
;FUNCTOR

33
basis/functors/functors.factor
View File

@ -1,17 +1,42 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel quotations classes.tuple make combinators generic
words interpolate namespaces sequences io.streams.string fry
classes.mixin effects lexer parser classes.tuple.parser
effects.parser locals.types locals.parser
locals.rewrite.closures vocabs.parser ;
locals.rewrite.closures vocabs.parser arrays accessors ;
IN: functors
! This is a hack
: scan-param ( -- obj )
scan-object dup special? [ literalize ] unless ;
: define* ( word def effect -- ) pick set-word define-declared ;
TUPLE: fake-quotation seq ;
GENERIC: >fake-quotations ( quot -- fake )
M: callable >fake-quotations
>array >fake-quotations fake-quotation boa ;
M: array >fake-quotations [ >fake-quotations ] { } map-as ;
M: object >fake-quotations ;
GENERIC: fake-quotations> ( fake -- quot )
M: fake-quotation fake-quotations>
seq>> [ fake-quotations> ] map >quotation ;
M: array fake-quotations> [ fake-quotations> ] map ;
M: object fake-quotations> ;
: parse-definition* ( -- )
parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
: DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
: `TUPLE:
@ -32,7 +57,7 @@ IN: functors
scan-param parsed
scan-param parsed
\ create-method parsed
parse-definition parsed
parse-definition*
DEFINE* ; parsing
: `C:
@ -45,7 +70,7 @@ IN: functors
: `:
effect off
scan-param parsed
parse-definition parsed
parse-definition*
DEFINE* ; parsing
: `INSTANCE:

4
basis/io/mmap/functor/functor.factor
View File

@ -20,9 +20,9 @@ with-mapped-A-file DEFINES with-mapped-${T}-file
WHERE
: <mapped-A> ( mapped-file -- direct-array )
T mapped-file>direct <A> execute ; inline
T mapped-file>direct <A> ; inline
: with-mapped-A-file ( path length quot -- )
'[ <mapped-A> execute @ ] with-mapped-file ; inline
'[ <mapped-A> @ ] with-mapped-file ; inline
;FUNCTOR

1
basis/math/blas/cblas/tags.txt
View File

@ -1,3 +1,2 @@
math
bindings
unportable

26
basis/math/blas/matrices/matrices.factor
View File

@ -268,28 +268,28 @@ TUPLE: MATRIX < blas-matrix-base ;
M: MATRIX element-type
drop TYPE ;
M: MATRIX (blas-matrix-like)
drop <MATRIX> execute ;
drop <MATRIX> ;
M: VECTOR (blas-matrix-like)
drop <MATRIX> execute ;
drop <MATRIX> ;
M: MATRIX (blas-vector-like)
drop <VECTOR> execute ;
drop <VECTOR> ;
: >MATRIX ( arrays -- matrix )
[ >ARRAY execute underlying>> ] (>matrix)
<MATRIX> execute ;
[ >ARRAY underlying>> ] (>matrix)
<MATRIX> ;
M: VECTOR n*M.V+n*V!
[ TYPE>ARG execute ] (prepare-gemv)
[ XGEMV execute ] dip ;
[ TYPE>ARG ] (prepare-gemv)
[ XGEMV ] dip ;
M: MATRIX n*M.M+n*M!
[ TYPE>ARG execute ] (prepare-gemm)
[ XGEMM execute ] dip ;
[ TYPE>ARG ] (prepare-gemm)
[ XGEMM ] dip ;
M: MATRIX n*V(*)V+M!
[ TYPE>ARG execute ] (prepare-ger)
[ XGERU execute ] dip ;
[ TYPE>ARG ] (prepare-ger)
[ XGERU ] dip ;
M: MATRIX n*V(*)Vconj+M!
[ TYPE>ARG execute ] (prepare-ger)
[ XGERC execute ] dip ;
[ TYPE>ARG ] (prepare-ger)
[ XGERC ] dip ;
;FUNCTOR

1
basis/math/blas/matrices/tags.txt
View File

@ -1,3 +1,2 @@
math
bindings
unportable

2
basis/math/blas/syntax/syntax.factor
View File

@ -1,5 +1,5 @@
USING: kernel math.blas.vectors math.blas.matrices parser
arrays prettyprint.backend sequences ;
arrays prettyprint.backend prettyprint.custom sequences ;
IN: math.blas.syntax
: svector{

1
basis/math/blas/syntax/tags.txt
View File

@ -1,2 +1 @@
math
unportable

1
basis/math/blas/vectors/tags.txt
View File

@ -1,2 +1 @@
math
unportable

52
basis/math/blas/vectors/vectors.factor
View File

@ -144,26 +144,26 @@ TUPLE: VECTOR < blas-vector-base ;
: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
: >VECTOR ( seq -- v )
[ >ARRAY execute underlying>> ] [ length ] bi 1 <VECTOR> execute ;
[ >ARRAY underlying>> ] [ length ] bi 1 <VECTOR> ;
M: VECTOR clone
TYPE heap-size (prepare-copy)
[ XCOPY execute ] 3dip <VECTOR> execute ;
[ XCOPY ] 3dip <VECTOR> ;
M: VECTOR element-type
drop TYPE ;
M: VECTOR Vswap
(prepare-swap) [ XSWAP execute ] 2dip ;
(prepare-swap) [ XSWAP ] 2dip ;
M: VECTOR Viamax
(prepare-nrm2) IXAMAX execute ;
(prepare-nrm2) IXAMAX ;
M: VECTOR (blas-vector-like)
drop <VECTOR> execute ;
drop <VECTOR> ;
M: VECTOR (blas-direct-array)
[ underlying>> ]
[ [ length>> ] [ inc>> ] bi * ] bi
<DIRECT-ARRAY> execute ;
<DIRECT-ARRAY> ;
;FUNCTOR
@ -180,17 +180,17 @@ XSCAL IS cblas_${T}scal
WHERE
M: VECTOR V.
(prepare-dot) XDOT execute ;
(prepare-dot) XDOT ;
M: VECTOR V.conj
(prepare-dot) XDOT execute ;
(prepare-dot) XDOT ;
M: VECTOR Vnorm
(prepare-nrm2) XNRM2 execute ;
(prepare-nrm2) XNRM2 ;
M: VECTOR Vasum
(prepare-nrm2) XASUM execute ;
(prepare-nrm2) XASUM ;
M: VECTOR n*V+V!
(prepare-axpy) [ XAXPY execute ] dip ;
(prepare-axpy) [ XAXPY ] dip ;
M: VECTOR n*V!
(prepare-scal) [ XSCAL execute ] dip ;
(prepare-scal) [ XSCAL ] dip ;
;FUNCTOR
@ -207,13 +207,13 @@ COMPLEX>ARG DEFINES ${TYPE}-complex>arg
WHERE
: <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
1 shift <DIRECT-ARRAY> <complex-sequence> ;
: >COMPLEX-ARRAY ( sequence -- sequence )
<complex-components> >ARRAY execute ;
<complex-components> >ARRAY ;
: COMPLEX>ARG ( complex -- alien )
>rect 2array >ARRAY execute underlying>> ;
>rect 2array >ARRAY underlying>> ;
: ARG>COMPLEX ( alien -- complex )
2 <DIRECT-ARRAY> execute first2 rect> ;
2 <DIRECT-ARRAY> first2 rect> ;
;FUNCTOR
@ -234,22 +234,22 @@ WHERE
M: VECTOR V.
(prepare-dot) TYPE <c-object>
[ XDOTU_SUB execute ] keep
ARG>TYPE execute ;
[ XDOTU_SUB ] keep
ARG>TYPE ;
M: VECTOR V.conj
(prepare-dot) TYPE <c-object>
[ XDOTC_SUB execute ] keep
ARG>TYPE execute ;
[ XDOTC_SUB ] keep
ARG>TYPE ;
M: VECTOR Vnorm
(prepare-nrm2) XXNRM2 execute ;
(prepare-nrm2) XXNRM2 ;
M: VECTOR Vasum
(prepare-nrm2) XXASUM execute ;
(prepare-nrm2) XXASUM ;
M: VECTOR n*V+V!
[ TYPE>ARG execute ] 2dip
(prepare-axpy) [ XAXPY execute ] dip ;
[ TYPE>ARG ] 2dip
(prepare-axpy) [ XAXPY ] dip ;
M: VECTOR n*V!
[ TYPE>ARG execute ] dip
(prepare-scal) [ XSCAL execute ] dip ;
[ TYPE>ARG ] dip
(prepare-scal) [ XSCAL ] dip ;
;FUNCTOR

6
basis/specialized-arrays/functor/functor.factor
View File

@ -49,9 +49,9 @@ M: A set-nth-unsafe underlying>> SET-NTH call ;
: >A ( seq -- specialized-array ) A new clone-like ; inline
M: A like drop dup A instance? [ >A execute ] unless ;
M: A like drop dup A instance? [ >A ] unless ;
M: A new-sequence drop (A) execute ;
M: A new-sequence drop (A) ;
M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
@ -70,7 +70,7 @@ M: A >pprint-sequence ;
M: A pprint* pprint-object ;
: A{ \ } [ >A execute ] parse-literal ; parsing
: A{ \ } [ >A ] parse-literal ; parsing
INSTANCE: A sequence

10
basis/specialized-vectors/functor/functor.factor
View File

@ -18,16 +18,16 @@ WHERE
TUPLE: V { underlying A } { length array-capacity } ;
: <V> ( capacity -- vector ) <A> execute 0 V boa ; inline
: <V> ( capacity -- vector ) <A> 0 V boa ; inline
M: V like
drop dup V instance? [
dup A instance? [ dup length V boa ] [ >V execute ] if
dup A instance? [ dup length V boa ] [ >V ] if
] unless ;
M: V new-sequence drop [ <A> execute ] [ >fixnum ] bi V boa ;
M: V new-sequence drop [ <A> ] [ >fixnum ] bi V boa ;
M: A new-resizable drop <V> execute ;
M: A new-resizable drop <V> ;
M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
@ -39,7 +39,7 @@ M: V >pprint-sequence ;
M: V pprint* pprint-object ;
: V{ \ } [ >V execute ] parse-literal ; parsing
: V{ \ } [ >V ] parse-literal ; parsing
INSTANCE: V growable