! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words specialized-arrays specialized-arrays.private locals
sequences sequences.private classes.tuple classes.mixin growable
fry kernel generic math classes compiler.units accessors ;
IN: specialized-vectors

<PRIVATE

:: define-vector-class ( class array-class -- )
    class tuple
    { { "underlying" array-class } { "length" array-capacity } }
    define-tuple-class
    class growable add-mixin-instance ;

: define-constructor ( constructor array-constructor class -- )
    '[ _ execute 0 _ boa ] define-inline ;

: define-like-method ( class predicate array-predicate class conversion -- )
    '[
        drop dup _ execute [
            dup _ execute
            [ dup length _ boa ] [ _ execute ] if
        ] unless
    ]
    \ like define-method ;

: define-new-sequence-method ( class constructor -- )
    over '[ drop [ _ execute ] [ >fixnum ] bi _ boa ]
    \ new-sequence define-method ;

: define-new-resizable-method ( array-class constructor -- )
    '[ drop _ execute ]
    \ new-resizable define-method ;

:: define-specialized-vector ( element-type vocab array-vocab -- )
    [let* | class [ element-type "-vector" append vocab create ]
            array-class [ element-type "-array" append array-vocab create ]
            constructor [ element-type "-vector" append vocab constructor-word ]
            array-constructor [ element-type "-array" append array-vocab constructor-word ]
            predicate [ class predicate-word ]
            array-predicate [ array-class predicate-word ]
            conversion [ class conversion-word ]
            parsing-word [ class parsing-word ] |
        class array-class define-vector-class
        constructor array-constructor class define-constructor
        class predicate array-predicate class conversion define-like-method
        class array-constructor define-new-sequence-method
        class predicate define-equal?-method
        array-class constructor define-new-resizable-method
        conversion class define-conversion
        parsing-word conversion define-parsing-word
        class parsing-word define-prettyprint-methods
    ] ;

PRIVATE>

[
    interesting-types [
        "specialized-vectors"
        "specialized-arrays"
        define-specialized-vector
    ] each
] with-compilation-unit