From 908644ee7ae8ffed26b17ca396bf2ceffad5afb5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 5 Dec 2008 07:28:52 -0600 Subject: [PATCH 1/4] O(1) and new-sequence on byte-arrays (work in progress) --- .../cfg/intrinsics/allot/allot.factor | 28 +++++++++++-------- .../compiler/cfg/intrinsics/intrinsics.factor | 2 ++ basis/specialized-arrays/double/double.factor | 2 ++ .../specialized-arrays/functor/functor.factor | 8 +++++- .../known-words/known-words.factor | 6 ++++ basis/tools/walker/walker.factor | 7 ++++- core/bootstrap/primitives.factor | 2 ++ core/byte-arrays/byte-arrays.factor | 2 +- core/byte-vectors/byte-vectors.factor | 4 +-- core/sbufs/sbufs.factor | 2 +- core/sequences/sequences-docs.factor | 2 +- core/sequences/sequences.factor | 5 +++- core/strings/strings.factor | 2 ++ vm/primitives.c | 2 ++ vm/types.c | 12 ++++++++ vm/types.h | 2 ++ 16 files changed, 68 insertions(+), 20 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor index ceac5e960c..3a4c702bc5 100644 --- a/basis/compiler/cfg/intrinsics/allot/allot.factor +++ b/basis/compiler/cfg/intrinsics/allot/allot.factor @@ -54,15 +54,19 @@ IN: compiler.cfg.intrinsics.allot : bytes>cells ( m -- n ) cell align cell /i ; -:: emit- ( node -- ) - [let | len [ node node-input-infos first literal>> ] | - len expand-? [ - [let | elt [ 0 ^^load-literal ] - reg [ len ^^allot-byte-array ] | - ds-drop - len reg store-length - elt reg len bytes>cells store-initial-element - reg ds-push - ] - ] [ node emit-primitive ] if - ] ; +: emit-allot-byte-array ( len -- dst ) + ds-drop + dup ^^allot-byte-array + [ store-length ] [ ds-push ] [ ] tri ; + +: emit-(byte-array) ( node -- ) + dup node-input-infos first literal>> dup expand-? + [ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ; + +: emit- ( node -- ) + dup node-input-infos first literal>> dup expand-? [ + nip + [ 0 ^^load-literal ] dip + [ emit-allot-byte-array ] keep + bytes>cells store-initial-element + ] [ drop emit-primitive ] if ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index cfc04fa036..4e3249f15a 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -49,6 +49,7 @@ IN: compiler.cfg.intrinsics classes.tuple.private: arrays: byte-arrays: + byte-arrays:(byte-array) math.private: math.private: kernel: @@ -131,6 +132,7 @@ IN: compiler.cfg.intrinsics { \ classes.tuple.private: [ emit- iterate-next ] } { \ arrays: [ emit- iterate-next ] } { \ byte-arrays: [ emit- iterate-next ] } + { \ byte-arrays:(byte-array) [ emit-(byte-array) iterate-next ] } { \ math.private: [ emit-simple-allot iterate-next ] } { \ math.private: [ emit-simple-allot iterate-next ] } { \ kernel: [ emit-simple-allot iterate-next ] } diff --git a/basis/specialized-arrays/double/double.factor b/basis/specialized-arrays/double/double.factor index 0501458532..02e47ca140 100644 --- a/basis/specialized-arrays/double/double.factor +++ b/basis/specialized-arrays/double/double.factor @@ -9,6 +9,8 @@ USING: hints math.vectors arrays kernel math accessors sequences ; HINTS: { 2 } { 3 } ; +HINTS: (double-array) { 2 } { 3 } ; + HINTS: vneg { array } { double-array } ; HINTS: v*n { array object } { double-array float } ; HINTS: n*v { array object } { float double-array } ; diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 52977dc22a..2a062105bb 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -10,10 +10,14 @@ ERROR: bad-byte-array-length byte-array type ; M: bad-byte-array-length summary drop "Byte array length doesn't divide type width" ; +: (c-array) ( n c-type -- array ) + heap-size * (byte-array) ; inline + FUNCTOR: define-array ( T -- ) A DEFINES ${T}-array DEFINES <${A}> +(A) DEFINES (${A}) >A DEFINES >${A} byte-array>A DEFINES byte-array>${A} A{ DEFINES ${A}{ @@ -29,6 +33,8 @@ TUPLE: A : ( n -- specialized-array ) dup T A boa ; inline +: (A) ( n -- specialized-array ) dup T (c-array) A boa ; inline + : byte-array>A ( byte-array -- specialized-array ) dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless swap A boa ; inline @@ -45,7 +51,7 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; M: A like drop dup A instance? [ >A execute ] unless ; -M: A new-sequence drop execute ; +M: A new-sequence drop (A) execute ; M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 2cb3d1f006..2ef181b179 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -483,6 +483,9 @@ M: object infer-call* \ { integer } { byte-array } define-primitive \ make-flushable +\ (byte-array) { integer } { byte-array } define-primitive +\ (byte-array) make-flushable + \ { integer c-ptr } { c-ptr } define-primitive \ make-flushable @@ -611,6 +614,9 @@ M: object infer-call* \ { integer integer } { string } define-primitive \ make-flushable +\ (string) { integer } { string } define-primitive +\ (string) make-flushable + \ array>quotation { array } { quotation } define-primitive \ array>quotation make-flushable diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 953291cc59..5410aef8c9 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators sequences math namespaces.private continuations.private concurrency.messaging quotations kernel.private words sequences.private assocs models models.filter arrays accessors -generic generic.standard definitions make ; +generic generic.standard definitions make sbufs ; IN: tools.walker SYMBOL: show-walker-hook ! ( status continuation thread -- ) @@ -147,10 +147,15 @@ SYMBOL: +stopped+ { (call-next-method) [ (step-into-call-next-method) ] } } [ "step-into" set-word-prop ] assoc-each +! Never step into these words { >n ndrop >c c> continue continue-with stop suspend (spawn) + ! Don't step into some sequence words since output of + ! (string) and new-sequence-unsafe may not print due to + ! memory safety issues + prepare-subseq subseq new-sequence-unsafe } [ dup [ execute break ] curry "step-into" set-word-prop diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 0a7e5fe233..d88247f383 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -468,6 +468,7 @@ tuple { "dlsym" "alien" } { "dlclose" "alien" } { "" "byte-arrays" } + { "(byte-array)" "byte-arrays" } { "" "alien" } { "alien-signed-cell" "alien.accessors" } { "set-alien-signed-cell" "alien.accessors" } @@ -519,6 +520,7 @@ tuple { "" "kernel" } { "(clone)" "kernel" } { "" "strings" } + { "(string)" "strings.private" } { "array>quotation" "quotations.private" } { "quotation-xt" "quotations" } { "" "classes.tuple.private" } diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor index f981e758d7..f0d188ce4a 100644 --- a/core/byte-arrays/byte-arrays.factor +++ b/core/byte-arrays/byte-arrays.factor @@ -9,7 +9,7 @@ M: byte-array length length>> ; M: byte-array nth-unsafe swap >fixnum alien-unsigned-1 ; M: byte-array set-nth-unsafe swap >fixnum set-alien-unsigned-1 ; : >byte-array ( seq -- byte-array ) B{ } clone-like ; inline -M: byte-array new-sequence drop ; +M: byte-array new-sequence drop (byte-array) ; M: byte-array equal? over byte-array? [ sequence= ] [ 2drop f ] if ; diff --git a/core/byte-vectors/byte-vectors.factor b/core/byte-vectors/byte-vectors.factor index 6938d02b2f..c273cea867 100644 --- a/core/byte-vectors/byte-vectors.factor +++ b/core/byte-vectors/byte-vectors.factor @@ -9,7 +9,7 @@ TUPLE: byte-vector { length array-capacity } ; : ( n -- byte-vector ) - 0 byte-vector boa ; inline + (byte-array) 0 byte-vector boa ; inline : >byte-vector ( seq -- byte-vector ) T{ byte-vector f B{ } 0 } clone-like ; @@ -21,7 +21,7 @@ M: byte-vector like ] unless ; M: byte-vector new-sequence - drop [ ] [ >fixnum ] bi byte-vector boa ; + drop [ (byte-array) ] [ >fixnum ] bi byte-vector boa ; M: byte-vector equal? over byte-vector? [ sequence= ] [ 2drop f ] if ; diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor index 5590432ef4..0b6f089443 100644 --- a/core/sbufs/sbufs.factor +++ b/core/sbufs/sbufs.factor @@ -8,7 +8,7 @@ TUPLE: sbuf { underlying string } { length array-capacity } ; -: ( n -- sbuf ) 0 0 sbuf boa ; inline +: ( n -- sbuf ) (string) 0 sbuf boa ; inline M: sbuf set-nth-unsafe [ >fixnum ] [ >fixnum ] [ underlying>> ] tri* set-string-nth ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 08831579bb..b5e8c17d9f 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -59,7 +59,7 @@ HELP: immutable HELP: new-sequence { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a mutable sequence" } } -{ $contract "Outputs a mutable sequence of length " { $snippet "n" } " which can hold the elements of " { $snippet "seq" } "." } ; +{ $contract "Outputs a mutable sequence of length " { $snippet "n" } " which can hold the elements of " { $snippet "seq" } ". The initial contents of the sequence are undefined." } ; HELP: new-resizable { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a resizable mutable sequence" } } diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 3461266081..dfe1c2b944 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -81,6 +81,7 @@ GENERIC: resize ( n seq -- newseq ) flushable ! Unsafe sequence protocol for inner loops GENERIC: nth-unsafe ( n seq -- elt ) flushable GENERIC: set-nth-unsafe ( elt n seq -- ) +GENERIC: new-sequence-unsafe ( len seq -- newseq ) flushable M: sequence nth bounds-check nth-unsafe ; M: sequence set-nth bounds-check set-nth-unsafe ; @@ -88,6 +89,8 @@ M: sequence set-nth bounds-check set-nth-unsafe ; M: sequence nth-unsafe nth ; M: sequence set-nth-unsafe set-nth ; +M: sequence new-sequence-unsafe new-sequence ; + ! The f object supports the sequence protocol trivially M: f length drop 0 ; M: f nth-unsafe nip ; @@ -256,7 +259,7 @@ INSTANCE: repetition immutable-sequence : prepare-subseq ( from to seq -- dst i src j n ) #! The check-length call forces partial dispatch - [ [ swap - ] dip new-sequence dup 0 ] 3keep + [ [ swap - ] dip new-sequence-unsafe dup 0 ] 3keep -rot drop roll length check-length ; inline : check-copy ( src n dst -- ) diff --git a/core/strings/strings.factor b/core/strings/strings.factor index 0c3f918fdc..6da7bfce0d 100644 --- a/core/strings/strings.factor +++ b/core/strings/strings.factor @@ -56,4 +56,6 @@ M: string resize resize-string ; M: string new-sequence drop 0 ; +M: string new-sequence-unsafe drop (string) ; + INSTANCE: string sequence diff --git a/vm/primitives.c b/vm/primitives.c index a01a8653b7..142db9e204 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -74,6 +74,7 @@ void *primitives[] = { primitive_dlsym, primitive_dlclose, primitive_byte_array, + primitive_uninitialized_byte_array, primitive_displaced_alien, primitive_alien_signed_cell, primitive_set_alien_signed_cell, @@ -125,6 +126,7 @@ void *primitives[] = { primitive_wrapper, primitive_clone, primitive_string, + primitive_uninitialized_string, primitive_array_to_quotation, primitive_quotation_xt, primitive_tuple, diff --git a/vm/types.c b/vm/types.c index a614011e7e..2a18030566 100755 --- a/vm/types.c +++ b/vm/types.c @@ -253,6 +253,12 @@ void primitive_byte_array(void) dpush(tag_object(allot_byte_array(size))); } +void primitive_uninitialized_byte_array(void) +{ + CELL size = unbox_array_size(); + dpush(tag_object(allot_byte_array_internal(size))); +} + F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity) { CELL to_copy = array_capacity(array); @@ -433,6 +439,12 @@ void primitive_string(void) dpush(tag_object(allot_string(length,initial))); } +void primitive_uninitialized_string(void) +{ + CELL length = unbox_array_size(); + dpush(tag_object(allot_string_internal(length))); +} + F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) { CELL to_copy = string_capacity(string); diff --git a/vm/types.h b/vm/types.h index 242939c502..d8d69dc541 100755 --- a/vm/types.h +++ b/vm/types.h @@ -116,6 +116,7 @@ void primitive_tuple(void); void primitive_tuple_boa(void); void primitive_tuple_layout(void); void primitive_byte_array(void); +void primitive_uninitialized_byte_array(void); void primitive_clone(void); F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill); @@ -125,6 +126,7 @@ void primitive_resize_byte_array(void); F_STRING* allot_string_internal(CELL capacity); F_STRING* allot_string(CELL capacity, CELL fill); +void primitive_uninitialized_string(void); void primitive_string(void); F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill); void primitive_resize_string(void); From d9231f3bc5afc9b78d437a48ccd609bab56fdd1f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 9 Dec 2008 17:53:00 -0600 Subject: [PATCH 2/4] Remove unsafe string allocation, since its of dubious value --- basis/tools/walker/walker.factor | 4 ---- core/bootstrap/primitives.factor | 1 - core/sbufs/sbufs.factor | 2 +- core/sequences/sequences.factor | 5 +---- core/strings/strings.factor | 2 -- 5 files changed, 2 insertions(+), 12 deletions(-) diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index a614e2eb0a..8915d2d611 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -152,10 +152,6 @@ SYMBOL: +stopped+ >n ndrop >c c> continue continue-with stop suspend (spawn) - ! Don't step into some sequence words since output of - ! (string) and new-sequence-unsafe may not print due to - ! memory safety issues - prepare-subseq subseq new-sequence-unsafe } [ dup [ execute break ] curry "step-into" set-word-prop diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 79cc922f78..6cc97531a4 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -520,7 +520,6 @@ tuple { "" "kernel" } { "(clone)" "kernel" } { "" "strings" } - { "(string)" "strings.private" } { "array>quotation" "quotations.private" } { "quotation-xt" "quotations" } { "" "classes.tuple.private" } diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor index 0b6f089443..5590432ef4 100644 --- a/core/sbufs/sbufs.factor +++ b/core/sbufs/sbufs.factor @@ -8,7 +8,7 @@ TUPLE: sbuf { underlying string } { length array-capacity } ; -: ( n -- sbuf ) (string) 0 sbuf boa ; inline +: ( n -- sbuf ) 0 0 sbuf boa ; inline M: sbuf set-nth-unsafe [ >fixnum ] [ >fixnum ] [ underlying>> ] tri* set-string-nth ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 8083cffe97..8c9eff94f5 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -81,7 +81,6 @@ GENERIC: resize ( n seq -- newseq ) flushable ! Unsafe sequence protocol for inner loops GENERIC: nth-unsafe ( n seq -- elt ) flushable GENERIC: set-nth-unsafe ( elt n seq -- ) -GENERIC: new-sequence-unsafe ( len seq -- newseq ) flushable M: sequence nth bounds-check nth-unsafe ; M: sequence set-nth bounds-check set-nth-unsafe ; @@ -89,8 +88,6 @@ M: sequence set-nth bounds-check set-nth-unsafe ; M: sequence nth-unsafe nth ; M: sequence set-nth-unsafe set-nth ; -M: sequence new-sequence-unsafe new-sequence ; - ! The f object supports the sequence protocol trivially M: f length drop 0 ; M: f nth-unsafe nip ; @@ -259,7 +256,7 @@ INSTANCE: repetition immutable-sequence : prepare-subseq ( from to seq -- dst i src j n ) #! The check-length call forces partial dispatch - [ [ swap - ] dip new-sequence-unsafe dup 0 ] 3keep + [ [ swap - ] dip new-sequence dup 0 ] 3keep -rot drop roll length check-length ; inline : check-copy ( src n dst -- ) diff --git a/core/strings/strings.factor b/core/strings/strings.factor index 6da7bfce0d..0c3f918fdc 100644 --- a/core/strings/strings.factor +++ b/core/strings/strings.factor @@ -56,6 +56,4 @@ M: string resize resize-string ; M: string new-sequence drop 0 ; -M: string new-sequence-unsafe drop (string) ; - INSTANCE: string sequence From ec23584f4879389809632b3ece94b66f8e7f5d78 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 9 Dec 2008 18:17:04 -0600 Subject: [PATCH 3/4] Finish up O(1) byte array allocation --- basis/alien/c-types/c-types.factor | 2 +- basis/bootstrap/stage2.factor | 6 +++++- basis/compiler/tree/propagation/slots/slots.factor | 3 ++- core/sequences/sequences-docs.factor | 6 +++--- vm/primitives.c | 1 - vm/types.c | 2 +- 6 files changed, 12 insertions(+), 8 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index c3ae644b47..ae148e3ac0 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -204,7 +204,7 @@ M: byte-array byte-length length ; dup length [ nip malloc dup ] 2keep memcpy ; : memory>byte-array ( alien len -- byte-array ) - [ nip dup ] 2keep memcpy ; + [ nip (byte-array) dup ] 2keep memcpy ; : byte-array>memory ( byte-array base -- ) swap dup length memcpy ; diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor index 78355a4670..fb7292b989 100644 --- a/basis/bootstrap/stage2.factor +++ b/basis/bootstrap/stage2.factor @@ -100,4 +100,8 @@ SYMBOL: bootstrap-time "output-image" get save-image-and-exit ] if -] [ drop "resource:basis/bootstrap/bootstrap-error.factor" run-file ] recover +] [ + drop + load-help? off + "resource:basis/bootstrap/bootstrap-error.factor" run-file +] recover diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index 83e71c3363..8192b1c520 100644 --- a/basis/compiler/tree/propagation/slots/slots.factor +++ b/basis/compiler/tree/propagation/slots/slots.factor @@ -14,12 +14,13 @@ IN: compiler.tree.propagation.slots UNION: fixed-length-sequence array byte-array string ; : sequence-constructor? ( word -- ? ) - { } memq? ; + { (byte-array) } memq? ; : constructor-output-class ( word -- class ) { { array } { byte-array } + { (byte-array) byte-array } { string } } at ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index a78117c35f..7354759bb6 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1,6 +1,6 @@ USING: arrays help.markup help.syntax math sequences.private vectors strings kernel math.order layouts -quotations ; +quotations generic.standard ; IN: sequences HELP: sequence @@ -14,8 +14,8 @@ HELP: length HELP: set-length { $values { "n" "a non-negative integer" } { "seq" "a resizable sequence" } } -{ $contract "Resizes the sequence. Not all sequences are resizable." } -{ $errors "Throws a " { $link bounds-error } " if the new length is negative." } +{ $contract "Resizes a sequence. The initial contents of the new area is undefined." } +{ $errors "Throws a " { $link no-method } " error if the sequence is not resizable, and a " { $link bounds-error } " if the new length is negative." } { $side-effects "seq" } ; HELP: lengthen diff --git a/vm/primitives.c b/vm/primitives.c index 142db9e204..dcf082d40d 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -126,7 +126,6 @@ void *primitives[] = { primitive_wrapper, primitive_clone, primitive_string, - primitive_uninitialized_string, primitive_array_to_quotation, primitive_quotation_xt, primitive_tuple, diff --git a/vm/types.c b/vm/types.c index 4a598dc601..c9e657f8ee 100755 --- a/vm/types.c +++ b/vm/types.c @@ -256,7 +256,7 @@ F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity) to_copy = capacity; REGISTER_UNTAGGED(array); - F_BYTE_ARRAY *new_array = allot_byte_array(capacity); + F_BYTE_ARRAY *new_array = allot_byte_array_internal(capacity); UNREGISTER_UNTAGGED(array); memcpy(new_array + 1,array + 1,to_copy); From 8b42b168e20353aee7eb1b60213ade70abb02b9a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 9 Dec 2008 18:22:38 -0600 Subject: [PATCH 4/4] Removed (string) primitivE --- basis/stack-checker/known-words/known-words.factor | 3 --- 1 file changed, 3 deletions(-) diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index ad4cadb743..bce42f1456 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -611,9 +611,6 @@ M: object infer-call* \ { integer integer } { string } define-primitive \ make-flushable -\ (string) { integer } { string } define-primitive -\ (string) make-flushable - \ array>quotation { array } { quotation } define-primitive \ array>quotation make-flushable