From 6a42dab8d558729b1f59983d5cefe219438e1cfa Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 12 Jun 2010 16:07:21 -0700 Subject: [PATCH] specialized-vectors: redefine "like" for the corresponding specialized-array of a specialized-vector to share storage when a vector is liked --- .../specialized-vectors/specialized-vectors.factor | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index f1a7a014eb..2b5b2f3f92 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.c-types alien.parser assocs -compiler.units functors growable kernel lexer math namespaces -parser prettyprint.custom sequences specialized-arrays -specialized-arrays.private strings vocabs vocabs.loader -vocabs.parser vocabs.generated fry make ; +classes compiler.units functors growable kernel lexer math +namespaces parser prettyprint.custom sequences +specialized-arrays specialized-arrays.private strings +vocabs vocabs.loader vocabs.parser vocabs.generated fry make ; FROM: sequences.private => nth-unsafe ; FROM: specialized-arrays.private => nth-c-ptr direct-like ; QUALIFIED: vectors.functor @@ -19,6 +19,7 @@ FUNCTOR: define-vector ( T -- ) V DEFINES-CLASS ${T}-vector A IS ${T}-array +>A IS >${A} IS <${A}> IS @@ -45,6 +46,11 @@ M: V byte-length [ length ] [ element-size ] bi * ; inline M: V direct-like drop ; inline M: V nth-c-ptr underlying>> nth-c-ptr ; inline +M: A like + drop dup A instance? [ + dup V instance? [ [ >c-ptr ] [ length>> ] bi ] [ >A ] if + ] unless ; inline + SYNTAX: V{ \ } [ >V ] parse-literal ; INSTANCE: V specialized-vector -- 2.34.1