From 6b5e40b2fccde34dd5fb4cd3693a6df8c22684f8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 4 Sep 2009 01:21:59 -0500
Subject: [PATCH] functors: support private words with DEFINES-PRIVATE; use
 this to make some words generated by math.vectors.simd.functor private

---
 basis/functors/functors.factor                |  2 +
 .../math/vectors/simd/functor/functor.factor  | 44 +++++++------------
 2 files changed, 17 insertions(+), 29 deletions(-)

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 62654ece79..dacd87507b 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -130,6 +130,8 @@ SYNTAX: DEFERS [ current-vocab create ] (INTERPOLATE) ;
 
 SYNTAX: DEFINES [ create-in ] (INTERPOLATE) ;
 
+SYNTAX: DEFINES-PRIVATE [ begin-private create-in end-private ] (INTERPOLATE) ;
+
 SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ;
 
 DEFER: ;FUNCTOR delimiter
diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor
index d1c98d02d7..1ed7cf7df7 100644
--- a/basis/math/vectors/simd/functor/functor.factor
+++ b/basis/math/vectors/simd/functor/functor.factor
@@ -12,8 +12,6 @@ FUNCTOR: define-simd-128 ( T -- )
 N            [ 16 T heap-size /i ]
 
 A            DEFINES-CLASS ${T}-${N}
-<A>          DEFINES <${A}>
-(A)          DEFINES (${A})
 >A           DEFINES >${A}
 A{           DEFINES ${A}{
 
@@ -21,18 +19,14 @@ NTH          [ T dup c-type-getter-boxer array-accessor ]
 SET-NTH      [ T dup c-setter array-accessor ]
 
 A-rep        IS ${A}-rep
-A-vv->v-op   DEFINES ${A}-vv->v-op
-A-v->n-op    DEFINES ${A}-v->n-op
+A-vv->v-op   DEFINES-PRIVATE ${A}-vv->v-op
+A-v->n-op    DEFINES-PRIVATE ${A}-v->n-op
 
 WHERE
 
 TUPLE: A
 { underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
 
-: <A> ( -- simd-array ) 16 <byte-array> \ A boa ; inline
-
-: (A) ( -- simd-array ) 16 (byte-array) \ A boa ; inline
-
 M: A clone underlying>> clone \ A boa ; inline
 
 M: A length drop N ; inline
@@ -45,7 +39,11 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; inline
 
 M: A like drop dup \ A instance? [ >A ] unless ; inline
 
-M: A new-sequence drop dup N = [ drop (A) ] [ N bad-length ] if ; inline
+M: A new-sequence
+    drop dup N =
+    [ drop 16 <byte-array> \ A boa ]
+    [ N bad-length ]
+    if ; inline
 
 M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ;
 
@@ -82,16 +80,14 @@ N/2          [ N 2 / ]
 A/2          IS ${T}-${N/2}
 
 A            DEFINES-CLASS ${T}-${N}
-<A>          DEFINES <${A}>
-(A)          DEFINES (${A})
 >A           DEFINES >${A}
 A{           DEFINES ${A}{
 
-A-deref      DEFINES ${A}-deref
+A-deref      DEFINES-PRIVATE ${A}-deref
 
 A-rep        IS ${A/2}-rep
-A-vv->v-op   DEFINES ${A}-vv->v-op
-A-v->n-op    DEFINES ${A}-v->n-op
+A-vv->v-op   DEFINES-PRIVATE ${A}-vv->v-op
+A-v->n-op    DEFINES-PRIVATE ${A}-v->n-op
 
 WHERE
 
@@ -102,25 +98,15 @@ TUPLE: A
 { underlying1 byte-array initial: $[ 16 <byte-array> ] read-only }
 { underlying2 byte-array initial: $[ 16 <byte-array> ] read-only } ;
 
-: <A> ( -- simd-array )
-    16 <byte-array> 16 <byte-array> \ A boa ; inline
-
-: (A) ( -- simd-array )
-    16 (byte-array) 16 (byte-array) \ A boa ; inline
-
 M: A clone
     [ underlying1>> clone ] [ underlying2>> clone ] bi
     \ A boa ; inline
 
 M: A length drop N ; inline
 
-<PRIVATE
-
 : A-deref ( n seq -- n' seq' )
     over N/2 < [ underlying1>> ] [ [ N/2 - ] dip underlying2>> ] if \ A/2 boa ; inline
 
-PRIVATE>
-
 M: A nth-unsafe A-deref nth-unsafe ; inline
 
 M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
@@ -129,7 +115,11 @@ M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
 
 M: A like drop dup \ A instance? [ >A ] unless ; inline
 
-M: A new-sequence drop dup N = [ drop (A) ] [ N bad-length ] if ; inline
+M: A new-sequence
+    drop dup N =
+    [ drop 16 <byte-array> 16 <byte-array> \ A boa ]
+    [ N bad-length ]
+    if ; inline
 
 M: A equal? over \ A instance? [ sequence= ] [ 2drop f ] if ;
 
@@ -145,8 +135,6 @@ M: A pprint* pprint-object ;
 
 INSTANCE: A sequence
 
-<PRIVATE
-
 : A-vv->v-op ( v1 v2 quot -- v3 )
     [ [ [ underlying1>> ] bi@ A-rep ] dip call ]
     [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
@@ -158,6 +146,4 @@ INSTANCE: A sequence
         [ [ underlying2>> A-rep ] dip call ] 2bi
     ] dip call ; inline
 
-PRIVATE>
-
 ;FUNCTOR