From f73f2b8697c043366e37e058ebf4ab862f9e2b77 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 30 Jan 2008 01:10:58 -0600 Subject: [PATCH] Assorted fixes --- core/bit-vectors/bit-vectors-docs.factor | 6 +-- core/bit-vectors/bit-vectors-tests.factor | 2 + core/bit-vectors/bit-vectors.factor | 2 +- core/bootstrap/syntax.factor | 3 ++ core/byte-vectors/byte-vectors-docs.factor | 2 +- core/byte-vectors/byte-vectors-tests.factor | 2 + core/cpu/arm/intrinsics/intrinsics.factor | 35 ----------------- core/cpu/ppc/intrinsics/intrinsics.factor | 37 ------------------ core/cpu/x86/intrinsics/intrinsics.factor | 39 ------------------- core/float-vectors/float-vectors-docs.factor | 2 +- core/float-vectors/float-vectors-tests.factor | 2 + core/float-vectors/float-vectors.factor | 4 +- core/hashtables/hashtables-docs.factor | 4 -- core/inference/known-words/known-words.factor | 18 ++++----- core/prettyprint/backend/backend.factor | 17 +++++--- core/syntax/syntax.factor | 17 ++++---- 16 files changed, 48 insertions(+), 144 deletions(-) diff --git a/core/bit-vectors/bit-vectors-docs.factor b/core/bit-vectors/bit-vectors-docs.factor index a16f58ec14..f2f5c4da2c 100755 --- a/core/bit-vectors/bit-vectors-docs.factor +++ b/core/bit-vectors/bit-vectors-docs.factor @@ -20,11 +20,11 @@ HELP: bit-vector { $description "The class of resizable bit vectors. See " { $link "syntax-bit-vectors" } " for syntax and " { $link "bit-vectors" } " for general information." } ; HELP: -{ $values { "n" "a positive integer specifying initial capacity" } { "vector" vector } } +{ $values { "n" "a positive integer specifying initial capacity" } { "bit-vector" bit-vector } } { $description "Creates a new bit vector that can hold " { $snippet "n" } " bits before resizing." } ; -HELP: >bit vector -{ $values { "seq" "a sequence" } { "vector" vector } } +HELP: >bit-vector +{ $values { "seq" "a sequence" } { "bit-vector" bit-vector } } { $description "Outputs a freshly-allocated bit vector with the same elements as a given sequence." } ; HELP: bit-array>vector diff --git a/core/bit-vectors/bit-vectors-tests.factor b/core/bit-vectors/bit-vectors-tests.factor index 2af9141ace..5838c1eb8d 100755 --- a/core/bit-vectors/bit-vectors-tests.factor +++ b/core/bit-vectors/bit-vectors-tests.factor @@ -10,3 +10,5 @@ USING: tools.test bit-vectors vectors sequences kernel math ; 3 dup do-it 3 dup do-it sequence= ] unit-test + +[ t ] [ ?V{ } bit-vector? ] unit-test diff --git a/core/bit-vectors/bit-vectors.factor b/core/bit-vectors/bit-vectors.factor index b22e3c2eef..f3259b2389 100755 --- a/core/bit-vectors/bit-vectors.factor +++ b/core/bit-vectors/bit-vectors.factor @@ -6,7 +6,7 @@ IN: bit-vectors vector ( bit-array -- bit-vector ) +: bit-array>vector ( bit-array length -- bit-vector ) bit-vector construct-boa ; inline PRIVATE> diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 2ddceabe44..4df5a68e97 100755 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -16,12 +16,15 @@ f swap set-vocab-source-loaded? ";" " -{ $values { "n" "a positive integer specifying initial capacity" } { "vector" vector } } +{ $values { "n" "a positive integer specifying initial capacity" } { "byte-vector" byte-vector } } { $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ; HELP: >byte-vector diff --git a/core/byte-vectors/byte-vectors-tests.factor b/core/byte-vectors/byte-vectors-tests.factor index 888d6957b2..2d9ca1f205 100755 --- a/core/byte-vectors/byte-vectors-tests.factor +++ b/core/byte-vectors/byte-vectors-tests.factor @@ -10,3 +10,5 @@ USING: tools.test byte-vectors vectors sequences kernel ; 3 do-it 3 do-it sequence= ] unit-test + +[ t ] [ BV{ } byte-vector? ] unit-test diff --git a/core/cpu/arm/intrinsics/intrinsics.factor b/core/cpu/arm/intrinsics/intrinsics.factor index 81b23ea8b2..29210afaa5 100755 --- a/core/cpu/arm/intrinsics/intrinsics.factor +++ b/core/cpu/arm/intrinsics/intrinsics.factor @@ -383,41 +383,6 @@ IN: cpu.arm.intrinsics { +output+ { "out" } } } define-intrinsic -\ (hashtable) [ - hashtable 4 cells %allot - R12 f v>operand MOV - R12 1 %set-slot - R12 2 %set-slot - R12 3 %set-slot - ! Store tagged ptr in reg - "out" get object %store-tagged -] H{ - { +scratch+ { { f "out" } } } - { +output+ { "out" } } -} define-intrinsic - -\ string>sbuf [ - sbuf 3 cells %allot - "length" operand 1 %set-slot - "string" operand 2 %set-slot - "out" get object %store-tagged -] H{ - { +input+ { { f "string" } { f "length" } } } - { +scratch+ { { f "out" } } } - { +output+ { "out" } } -} define-intrinsic - -\ array>vector [ - vector 3 cells %allot - "length" operand 1 %set-slot - "array" operand 2 %set-slot - "out" get object %store-tagged -] H{ - { +input+ { { f "array" } { f "length" } } } - { +scratch+ { { f "out" } } } - { +output+ { "out" } } -} define-intrinsic - ! Alien intrinsics : %alien-accessor ( quot -- ) "offset" operand dup %untag-fixnum diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 0773dae947..c73cd149a4 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -586,43 +586,6 @@ IN: cpu.ppc.intrinsics { +output+ { "wrapper" } } } define-intrinsic -\ (hashtable) [ - hashtable 4 cells %allot - f v>operand 12 LI - 12 11 1 cells STW - 12 11 2 cells STW - 12 11 3 cells STW - ! Store tagged ptr in reg - "hashtable" get object %store-tagged -] H{ - { +scratch+ { { f "hashtable" } } } - { +output+ { "hashtable" } } -} define-intrinsic - -\ string>sbuf [ - sbuf 3 cells %allot - "length" operand 11 1 cells STW - "string" operand 11 2 cells STW - ! Store tagged ptr in reg - "sbuf" get object %store-tagged -] H{ - { +input+ { { f "string" } { f "length" } } } - { +scratch+ { { f "sbuf" } } } - { +output+ { "sbuf" } } -} define-intrinsic - -\ array>vector [ - vector 3 cells %allot - "length" operand 11 1 cells STW - "array" operand 11 2 cells STW - ! Store tagged ptr in reg - "vector" get object %store-tagged -] H{ - { +input+ { { f "array" } { f "length" } } } - { +scratch+ { { f "vector" } } } - { +output+ { "vector" } } -} define-intrinsic - ! Alien intrinsics : %alien-accessor ( quot -- ) "offset" operand dup %untag-fixnum diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index 0e9d66498d..1fc649e128 100755 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -447,45 +447,6 @@ IN: cpu.x86.intrinsics { +output+ { "wrapper" } } } define-intrinsic -\ (hashtable) [ - hashtable 4 cells [ - 1 object@ f v>operand MOV - 2 object@ f v>operand MOV - 3 object@ f v>operand MOV - ! Store tagged ptr in reg - "hashtable" get object %store-tagged - ] %allot -] H{ - { +scratch+ { { f "hashtable" } } } - { +output+ { "hashtable" } } -} define-intrinsic - -\ string>sbuf [ - sbuf 3 cells [ - 1 object@ "length" operand MOV - 2 object@ "string" operand MOV - ! Store tagged ptr in reg - "sbuf" get object %store-tagged - ] %allot -] H{ - { +input+ { { f "string" } { f "length" } } } - { +scratch+ { { f "sbuf" } } } - { +output+ { "sbuf" } } -} define-intrinsic - -\ array>vector [ - vector 3 cells [ - 1 object@ "length" operand MOV - 2 object@ "array" operand MOV - ! Store tagged ptr in reg - "vector" get object %store-tagged - ] %allot -] H{ - { +input+ { { f "array" } { f "length" } } } - { +scratch+ { { f "vector" } } } - { +output+ { "vector" } } -} define-intrinsic - ! Alien intrinsics : %alien-accessor ( quot -- ) "offset" operand %untag-fixnum diff --git a/core/float-vectors/float-vectors-docs.factor b/core/float-vectors/float-vectors-docs.factor index 4d04101e7b..5be891945a 100755 --- a/core/float-vectors/float-vectors-docs.factor +++ b/core/float-vectors/float-vectors-docs.factor @@ -20,7 +20,7 @@ HELP: float-vector { $description "The class of resizable float vectors. See " { $link "syntax-float-vectors" } " for syntax and " { $link "float-vectors" } " for general information." } ; HELP: -{ $values { "n" "a positive integer specifying initial capacity" } { "vector" vector } } +{ $values { "n" "a positive integer specifying initial capacity" } { "float-vector" float-vector } } { $description "Creates a new float vector that can hold " { $snippet "n" } " floats before resizing." } ; HELP: >float-vector diff --git a/core/float-vectors/float-vectors-tests.factor b/core/float-vectors/float-vectors-tests.factor index 11f87f1f52..68b8195eb7 100755 --- a/core/float-vectors/float-vectors-tests.factor +++ b/core/float-vectors/float-vectors-tests.factor @@ -10,3 +10,5 @@ USING: tools.test float-vectors vectors sequences kernel ; 3 do-it 3 do-it sequence= ] unit-test + +[ t ] [ FV{ } float-vector? ] unit-test diff --git a/core/float-vectors/float-vectors.factor b/core/float-vectors/float-vectors.factor index fa19e3aaf8..f666a260f8 100755 --- a/core/float-vectors/float-vectors.factor +++ b/core/float-vectors/float-vectors.factor @@ -6,7 +6,7 @@ IN: float-vectors vector ( float-array -- float-vector ) +: float-array>vector ( float-array length -- float-vector ) float-vector construct-boa ; inline PRIVATE> @@ -23,7 +23,7 @@ M: float-vector like ] unless ; M: float-vector new - drop [ ] keep >fixnum float-array>vector ; + drop [ 0.0 ] keep >fixnum float-array>vector ; M: float-vector equal? over float-vector? [ sequence= ] [ 2drop f ] if ; diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor index 7b6c2d1dc9..563a59d20f 100755 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -116,10 +116,6 @@ HELP: { $values { "n" "a positive integer specifying hashtable capacity" } { "hash" "a new hashtable" } } { $description "Create a new hashtable capable of storing " { $snippet "n" } " key/value pairs before growing." } ; -HELP: (hashtable) ( -- hash ) -{ $values { "hash" "a new hashtable" } } -{ $description "Allocates a hashtable stub object without an underlying array. User code should call " { $link } " instead." } ; - HELP: associate { $values { "value" "a value" } { "key" "a key" } { "hash" "a new " { $link hashtable } } } { $description "Create a new hashtable holding one key/value pair." } ; diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 72935f1405..9a826d8e9b 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -167,9 +167,6 @@ t over set-effect-terminated? \ rehash-string { string } { } "inferred-effect" set-word-prop -\ string>sbuf { string integer } { sbuf } "inferred-effect" set-word-prop -\ string>sbuf make-flushable - \ bignum>fixnum { bignum } { fixnum } "inferred-effect" set-word-prop \ bignum>fixnum make-foldable @@ -491,12 +488,18 @@ t over set-effect-terminated? \ resize-array { integer array } { array } "inferred-effect" set-word-prop \ resize-array make-flushable +\ resize-byte-array { integer byte-array } { byte-array } "inferred-effect" set-word-prop +\ resize-byte-array make-flushable + +\ resize-bit-array { integer bit-array } { bit-array } "inferred-effect" set-word-prop +\ resize-bit-array make-flushable + +\ resize-float-array { integer float-array } { float-array } "inferred-effect" set-word-prop +\ resize-float-array make-flushable + \ resize-string { integer string } { string } "inferred-effect" set-word-prop \ resize-string make-flushable -\ (hashtable) { } { hashtable } "inferred-effect" set-word-prop -\ (hashtable) make-flushable - \ { integer object } { array } "inferred-effect" set-word-prop \ make-flushable @@ -532,9 +535,6 @@ t over set-effect-terminated? \ (clone) { object } { object } "inferred-effect" set-word-prop \ (clone) make-flushable -\ array>vector { array integer } { vector } "inferred-effect" set-word-prop -\ array>vector make-flushable - \ { integer integer } { string } "inferred-effect" set-word-prop \ make-flushable diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor index 380ab87d40..86ac6cd926 100755 --- a/core/prettyprint/backend/backend.factor +++ b/core/prettyprint/backend/backend.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2003, 2007 Slava Pestov. +! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays byte-arrays bit-arrays generic hashtables io -assocs kernel math namespaces sequences strings sbufs io.styles -vectors words prettyprint.config prettyprint.sections quotations -io io.files math.parser effects tuples classes float-arrays ; +USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors +generic hashtables io assocs kernel math namespaces sequences +strings sbufs io.styles vectors words prettyprint.config +prettyprint.sections quotations io io.files math.parser effects +tuples classes float-arrays float-vectors ; IN: prettyprint.backend GENERIC: pprint* ( obj -- ) @@ -143,8 +144,11 @@ M: quotation pprint-delims drop \ [ \ ] ; M: curry pprint-delims drop \ [ \ ] ; M: array pprint-delims drop \ { \ } ; M: byte-array pprint-delims drop \ B{ \ } ; +M: byte-vector pprint-delims drop \ BV{ \ } ; M: bit-array pprint-delims drop \ ?{ \ } ; +M: bit-vector pprint-delims drop \ ?V{ \ } ; M: float-array pprint-delims drop \ F{ \ } ; +M: float-vector pprint-delims drop \ FV{ \ } ; M: vector pprint-delims drop \ V{ \ } ; M: hashtable pprint-delims drop \ H{ \ } ; M: tuple pprint-delims drop \ T{ \ } ; @@ -156,6 +160,9 @@ GENERIC: >pprint-sequence ( obj -- seq ) M: object >pprint-sequence ; M: vector >pprint-sequence ; +M: bit-vector >pprint-sequence ; +M: byte-vector >pprint-sequence ; +M: float-vector >pprint-sequence ; M: hashtable >pprint-sequence >alist ; M: tuple >pprint-sequence tuple>array ; M: wrapper >pprint-sequence wrapped 1array ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 7616f6e64b..006f1a225f 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays bit-arrays byte-arrays definitions generic -hashtables kernel math namespaces parser sequences strings sbufs -vectors words quotations io assocs splitting tuples -generic.standard generic.math classes io.files vocabs -float-arrays classes.union classes.mixin classes.predicate -compiler.units ; +USING: alien arrays bit-arrays bit-vectors byte-arrays +byte-vectors definitions generic hashtables kernel math +namespaces parser sequences strings sbufs vectors words +quotations io assocs splitting tuples generic.standard +generic.math classes io.files vocabs float-arrays float-vectors +classes.union classes.mixin classes.predicate compiler.units ; IN: bootstrap.syntax ! These words are defined as a top-level form, instead of with @@ -71,8 +71,11 @@ IN: bootstrap.syntax "{" [ \ } [ >array ] parse-literal ] define-syntax "V{" [ \ } [ >vector ] parse-literal ] define-syntax "B{" [ \ } [ >byte-array ] parse-literal ] define-syntax + "BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax "?{" [ \ } [ >bit-array ] parse-literal ] define-syntax + "?V{" [ \ } [ >bit-vector ] parse-literal ] define-syntax "F{" [ \ } [ >float-array ] parse-literal ] define-syntax + "FV{" [ \ } [ >float-vector ] parse-literal ] define-syntax "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax "T{" [ \ } [ >tuple ] parse-literal ] define-syntax "W{" [ \ } [ first ] parse-literal ] define-syntax