slavapestov / factor

Factor programming language - Github mirror of official GIT repo

This URL has Read+Write access

factor / basis / tuple-arrays / tuple-arrays.factor
raw normal view history
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 1 ! Copyright (C) 2009 Slava Pestov.
a96457ce » slavapestov 2007-09-20 Initial import 2 ! See http://factorcode.org/license.txt for BSD license.
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 3 USING: accessors arrays combinators.smart fry functors kernel
4 kernel.private macros sequences combinators sequences.private
5 stack-checker parser math classes.tuple.private ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 6 FROM: inverse => undo ;
a96457ce » slavapestov 2007-09-20 Initial import 7 IN: tuple-arrays
8
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 9 <PRIVATE
a96457ce » slavapestov 2007-09-20 Initial import 10
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 11 MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
12
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 13 MACRO: infer-in ( class -- quot ) infer in>> '[ _ ] ;
a96457ce » slavapestov 2007-09-20 Initial import 14
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 15 : tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline
16
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 17 : smart-tuple>array ( tuple class -- array )
18 '[ [ _ boa ] undo ] output>array ; inline
a96457ce » slavapestov 2007-09-20 Initial import 19
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 20 : tuple-prototype ( class -- array )
21 [ new ] [ smart-tuple>array ] bi ; inline
22
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 23 : tuple-slice ( n seq -- slice )
24 [ n>> [ * dup ] keep + ] [ seq>> ] bi { array } declare slice boa ; inline
25
26 : read-tuple ( slice class -- tuple )
27 '[ _ boa-unsafe ] input<sequence-unsafe ; inline
28
29 MACRO: write-tuple ( class -- quot )
30 [ '[ [ _ boa ] undo ] ]
31 [ tuple-arity <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
32 bi '[ _ dip @ ] ;
33
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 34 PRIVATE>
35
36 FUNCTOR: define-tuple-array ( CLASS -- )
37
38 CLASS IS ${CLASS}
39
40 CLASS-array DEFINES-CLASS ${CLASS}-array
41 CLASS-array? IS ${CLASS-array}?
42
43 <CLASS-array> DEFINES <${CLASS}-array>
44 >CLASS-array DEFINES >${CLASS}-array
45
46 WHERE
47
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 48 TUPLE: CLASS-array
49 { seq array read-only }
50 { n array-capacity read-only }
51 { length array-capacity read-only } ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 52
53 : <CLASS-array> ( length -- tuple-array )
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 54 [ \ CLASS [ tuple-prototype <repetition> concat ] [ tuple-arity ] bi ] keep
55 \ CLASS-array boa ; inline
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 56
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 57 M: CLASS-array length length>> ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 58
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 59 M: CLASS-array nth-unsafe tuple-slice \ CLASS read-tuple ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 60
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 61 M: CLASS-array set-nth-unsafe tuple-slice \ CLASS write-tuple ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 62
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 63 M: CLASS-array new-sequence drop <CLASS-array> ;
a96457ce » slavapestov 2007-09-20 Initial import 64
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 65 : >CLASS-array ( seq -- tuple-array ) 0 <CLASS-array> clone-like ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 66
84f672e7 » slavapestov 2009-04-26 tuple-arrays: further perfo... 67 M: CLASS-array like drop dup CLASS-array? [ >CLASS-array ] unless ;
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 68
69 INSTANCE: CLASS-array sequence
a96457ce » slavapestov 2007-09-20 Initial import 70
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 71 ;FUNCTOR
1e829b18 » Dan Ehrenberg 2008-07-12 Delegate removed from tuple... 72
291ac48a » slavapestov 2009-04-26 tuple-arrays: completely re... 73 SYNTAX: TUPLE-ARRAY: scan-word define-tuple-array ;