WHERE
-: WW W twice ; inline
+: WW ( a -- b ) \ W twice ; inline
;FUNCTOR
-! 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:
scan-param parsed
scan-param parsed
\ create-method parsed
- parse-definition parsed
+ parse-definition*
DEFINE* ; parsing
: `C:
: `:
effect off
scan-param parsed
- parse-definition parsed
+ parse-definition*
DEFINE* ; parsing
: `INSTANCE:
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
math
bindings
-unportable
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
math
bindings
-unportable
USING: kernel math.blas.vectors math.blas.matrices parser
-arrays prettyprint.backend sequences ;
+arrays prettyprint.backend prettyprint.custom sequences ;
IN: math.blas.syntax
: svector{
: <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
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
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
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
: >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 ;
M: A pprint* pprint-object ;
-: A{ \ } [ >A execute ] parse-literal ; parsing
+: A{ \ } [ >A ] parse-literal ; parsing
INSTANCE: A sequence
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 ;
M: V pprint* pprint-object ;
-: V{ \ } [ >V execute ] parse-literal ; parsing
+: V{ \ } [ >V ] parse-literal ; parsing
INSTANCE: V growable