1 ! Copyright (C) 2010 Slava Pestov.
2 USING: accessors kernel math sequences sequences.private
3 hashtables assocs locals arrays combinators classes.struct
4 math.vectors math.vectors.simd math.vectors.simd.cords ;
7 : true? ( obj -- ? ) 0 number= not ; inline
8 : >true ( ? -- 1/0 ) 1 0 ? ; inline
10 TUPLE: proc { array array read-only } { registers array read-only } ;
14 M: proc clone [ array>> clone ] [ registers>> clone ] bi <proc> ;
16 M: proc length array>> length ;
17 M: proc nth-unsafe array>> nth-unsafe ;
18 M: proc set-nth-unsafe array>> set-nth-unsafe ;
19 M: proc like drop dup proc? [ { } like { } <proc> ] unless ;
20 M: proc new-sequence drop 0 <array> { } <proc> ;
22 INSTANCE: proc sequence
24 : wrap ( n seq -- n seq ) [ length rem ] keep ; inline
26 GENERIC# (gml-get) 1 ( collection key -- elt )
28 M: sequence (gml-get) swap wrap nth ;
29 M: hashtable (gml-get) of ;
31 GENERIC# (gml-put) 2 ( collection key elt -- )
33 M:: sequence (gml-put) ( collection key elt -- )
34 elt key collection wrap set-nth ;
35 M:: hashtable (gml-put) ( collection key elt -- )
36 elt key collection set-at ;
38 GENERIC: (gml-copy) ( collection -- collection' )
40 M: array (gml-copy) clone ;
41 M: hashtable (gml-copy) clone ;
42 M: proc (gml-copy) clone ;
44 ALIAS: vec2d? double-2?
46 ALIAS: <vec2d> double-2-boa
48 ALIAS: scalar>vec2d double-2-with
50 ALIAS: vec3d? double-4?
52 : <vec3d> ( x y z -- vec ) 0.0 double-4-boa ; inline
54 : scalar>vec3d ( x -- vec ) dup dup 0.0 double-4-boa ; inline
56 GENERIC: mask-vec3d ( value -- value' )
58 M: double-2 mask-vec3d ; inline
60 M: double-4 mask-vec3d
61 longlong-4{ -1 -1 -1 0 } double-4-cast vbitand ; inline