! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: sequences sequences.private kernel math byte-arrays accessors generic words quotations locals fry alien.c-types classes classes.tuple parser lexer namespaces compiler.units prettyprint.backend ; IN: specialized-arrays GENERIC: element-size ( array -- type ) TUPLE: specialized-array { length array-capacity } { underlying byte-array } ; >>underlying swap >>length ; inline M: specialized-array clone clone [ clone ] change-underlying ; M: specialized-array length length>> ; M: specialized-array resize [ [ element-size * ] [ underlying>> ] bi resize-byte-array ] 2keep clone swap >>length swap >>underlying ; M: specialized-array byte-length underlying>> length ; INSTANCE: specialized-array sequence : define-method ( class body generic -- ) swap [ create-method ] dip define ; : define-element-size-method ( class element-type -- ) '[ drop _ ] \ element-size define-method ; : define-nth-method ( class getter -- ) '[ underlying>> @ ] \ nth-unsafe define-method ; : define-set-nth-method ( class setter -- ) '[ underlying>> @ ] \ set-nth-unsafe define-method ; : define-new-sequence-method ( class constructor -- ) '[ drop _ execute ] \ new-sequence define-method ; : define-like-method ( class predicate conversion -- ) '[ drop dup _ execute [ _ execute ] unless ] \ like define-method ; : define-equal?-method ( class predicate -- ) '[ over _ execute [ sequence= ] [ 2drop f ] if ] \ equal? define-method ; : define-conversion ( conversion class -- ) new '[ _ clone-like ] define-inline ; : define-constructor ( constructor class -- ) '[ _ new-specialized-array ] define-inline ; : conversion-word ( class -- word ) [ name>> ">" prepend ] [ vocabulary>> ] bi create ; : parsing-word ( class -- word ) [ name>> "{" append ] [ vocabulary>> ] bi create ; : define-parsing-word ( parsing-word conversion -- ) dupd '[ \ } [ _ execute ] parse-literal ] define make-parsing ; : define-prettyprint-methods ( class parsing-word -- ) [ '[ drop _ \ } ] \ pprint-delims define-method ] [ drop [ ] \ >pprint-sequence define-method ] [ drop [ pprint-object ] \ pprint* define-method ] 2tri ; :: define-specialized-array ( element-type vocab -- ) [let* | class [ element-type "-array" append vocab create ] element-size [ element-type heap-size ] getter [ element-type dup c-getter array-accessor ] setter [ element-type dup c-setter array-accessor ] constructor [ element-type "-array" append vocab constructor-word ] predicate [ class predicate-word ] conversion [ class conversion-word ] parsing-word [ class parsing-word ] | class specialized-array { } define-tuple-class class element-size define-element-size-method class getter define-nth-method class setter define-set-nth-method class predicate conversion define-like-method class predicate define-equal?-method class constructor define-new-sequence-method conversion class define-conversion constructor class define-constructor parsing-word conversion define-parsing-word class parsing-word define-prettyprint-methods ] ; : interesting-types { "char" "uchar" "short" "ushort" "int" "uint" "long" "ulong" "longlong" "ulonglong" "float" "double" "void*" } ; PRIVATE> [ interesting-types [ "specialized-arrays" define-specialized-array ] each ] with-compilation-unit