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

basis/functors/functors-tests.factor

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

basis/functors/functors.factor

@@ -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:

basis/io/mmap/functor/functor.factor

@@ -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

basis/math/blas/cblas/tags.txt

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

basis/math/blas/matrices/matrices.factor

@@ -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)
+    [ >ARRAY underlying>> ] (>matrix)
-    <MATRIX> execute ;
+    <MATRIX> ;
 
 M: VECTOR n*M.V+n*V!
-    [ TYPE>ARG execute ] (prepare-gemv)
+    [ TYPE>ARG ] (prepare-gemv)
-    [ XGEMV execute ] dip ;
+    [ XGEMV ] dip ;
 M: MATRIX n*M.M+n*M!
-    [ TYPE>ARG execute ] (prepare-gemm)
+    [ TYPE>ARG ] (prepare-gemm)
-    [ XGEMM execute ] dip ;
+    [ XGEMM ] dip ;
 M: MATRIX n*V(*)V+M!
-    [ TYPE>ARG execute ] (prepare-ger)
+    [ TYPE>ARG ] (prepare-ger)
-    [ XGERU execute ] dip ;
+    [ XGERU ] dip ;
 M: MATRIX n*V(*)Vconj+M!
-    [ TYPE>ARG execute ] (prepare-ger)
+    [ TYPE>ARG ] (prepare-ger)
-    [ XGERC execute ] dip ;
+    [ XGERC ] dip ;
 
 ;FUNCTOR
 

basis/math/blas/matrices/tags.txt

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

basis/math/blas/syntax/syntax.factor

@@ -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{

basis/math/blas/syntax/tags.txt

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

basis/math/blas/vectors/tags.txt

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

basis/math/blas/vectors/vectors.factor

@@ -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
+    [ XDOTU_SUB ] keep
-    ARG>TYPE execute ;
+    ARG>TYPE ;
 M: VECTOR V.conj
     (prepare-dot) TYPE <c-object>
-    [ XDOTC_SUB execute ] keep
+    [ XDOTC_SUB ] keep
-    ARG>TYPE execute ;
+    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
+    [ TYPE>ARG ] 2dip
-    (prepare-axpy) [ XAXPY execute ] dip ;
+    (prepare-axpy) [ XAXPY ] dip ;
 M: VECTOR n*V!
-    [ TYPE>ARG execute ] dip
+    [ TYPE>ARG ] dip
-    (prepare-scal) [ XSCAL execute ] dip ;
+    (prepare-scal) [ XSCAL ] dip ;
 
 ;FUNCTOR
 

basis/specialized-arrays/functor/functor.factor

@@ -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
 

basis/specialized-vectors/functor/functor.factor

@@ -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