Documenting primitives; folded make-tuple into <tuple> primitive

TODO.FACTOR.txt

@@ -4,6 +4,7 @@
 [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 
 ]
 
+- if a primitive throws an error, :c doesn't show the call frame there
 - running all help entries:
   - without a yield UI runs out of memory
   - leaves array array on the stack

library/collections/arrays.facts

@@ -2,10 +2,14 @@ IN: arrays
 USING: help kernel kernel-internals prettyprint strings
 vectors ;
 
+HELP: <byte-array> "( n -- byte-array )"
+{ $values { "n" "a non-negative integer" } { "byte-array" "a new byte array" } }
+{ $description "Creates a new byte array holding " { $snippet "n" } " cells." } ;
+
 HELP: <array> "( n elt -- array )"
-{ $values { "n" "a positive integer specifying array length" } { "elt" "an initial element" } }
+{ $values { "n" "a non-negative integer" } { "elt" "an initial element" } { "array" "a new array" } }
 { $description "Creates a new array with the given length and all elements initially set to " { $snippet "elt" } "." }
-{ $see-also <string> <sbuf> <vector> } ;
+{ $see-also <quotation> <string> <sbuf> <vector> } ;
 
 HELP: >array "( seq -- array )"
 { $values { "seq" "a sequence" } { "array" "an array" } }

library/collections/sbuf.facts

@@ -1,10 +1,10 @@
 IN: strings
-USING: arrays help vectors ;
+USING: arrays help kernel vectors ;
 
 HELP: <sbuf> "( n -- sbuf )"
 { $values { "n" "a positive integer specifying initial capacity" } { "sbuf" "a new string buffer" } }
 { $description "Creates a new string buffer that can hold " { $snippet "n" } " characters before resizing." }
-{ $see-also <array> <string> <vector> } ;
+{ $see-also <array> <quotation> <string> <vector> } ;
 
 HELP: >sbuf "( seq -- sbuf )"
 { $values { "seq" "a sequence of non-negative integers" } { "sbuf" "a string buffer" } }

library/collections/strings.facts

@@ -3,7 +3,7 @@ USING: arrays help kernel strings vectors ;
 HELP: <string> "( n ch -- string )"
 { $values { "n" "a positive integer specifying string length" } { "elt" "an initial character" } }
 { $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." }
-{ $see-also <array> <sbuf> <vector> } ;
+{ $see-also <array> <quotation> <sbuf> <vector> } ;
 
 HELP: blank? "( ch -- ? )"
 { $values { "ch" "a character" } { "?" "a boolean" } }

library/collections/vectors.facts

@@ -9,6 +9,12 @@ HELP: >vector "( seq -- vector )"
 { $values { "seq" "a sequence" } { "vector" "a new vector" } }
 { $description "Outputs a freshly-allocated vector with the same elements as a given sequence." } ;
 
+HELP: array>vector "( array -- vector )"
+{ $values { "array" "an array" } { "vector" "a new vector" } }
+{ $description "Creates a new vector using the array for underlying storage. The vector's initial length is the same as that of the array."
+$terpri
+"This word can be marginally more efficient than " { $link >vector } ", but the sharing of storage can lead to unexpected results." } ;
+
 HELP: with-datastack "( stack word -- newstack )"
 { $values { "stack" "a sequence" } { "word" "a word" } { "newstack" "a sequence" } }
 { $description "Executes " { $snippet "word" } " with the given data stack contents, and outputs the new data stack after the word returns. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }

library/compiler/alien/c-types.facts

@@ -53,6 +53,17 @@ HELP: alien>char-string "( c-ptr -- string )"
 { $description "Reads a null-terminated 8-bit C string from the specified address." }
 { $see-also string>char-alien } ;
 
+HELP: string>u16-alien "( string -- array )"
+{ $values { "string" "a string" } { "array" "a byte array" } }
+{ $description "Copies the string to a new byte array in UTF16 format with a trailing null byte." }
+{ $errors "Throws an error if the string contains null characters." }
+{ $see-also alien>u16-string } ;
+
+HELP: alien>u16-string "( c-ptr -- string )"
+{ $values { "c-ptr" "an alien, byte array or " { $link f } } { "string" "a string" } }
+{ $description "Reads a null-terminated UTF16 string from the specified address." }
+{ $see-also string>u16-alien } ;
+
 HELP: <malloc-array> "( n type -- alien )"
 { $values { "n" "a non-negative integer" } { "type" "a string" } { "alien" "an alien address" } }
 { $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type." }

library/compiler/inference/known-words.factor

@@ -333,8 +333,8 @@ sequences strings vectors words prettyprint ;
 \ fsqrt t "flushable" set-word-prop
 \ fsqrt t "foldable" set-word-prop
 
-\ <word> [ [ object object ] [ word ] ] "infer-effect" set-word-prop
-\ <word> t "flushable" set-word-prop
+\ (word) [ [ object object ] [ word ] ] "infer-effect" set-word-prop
+\ (word) t "flushable" set-word-prop
 
 \ update-xt [ [ word ] [ ] ] "infer-effect" set-word-prop
 \ compiled? [ [ word ] [ object ] ] "infer-effect" set-word-prop
@@ -343,8 +343,8 @@ sequences strings vectors words prettyprint ;
 \ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
 \ stat [ [ string ] [ array ] ] "infer-effect" set-word-prop
 \ (directory) [ [ string ] [ array ] ] "infer-effect" set-word-prop
-\ gc [ [ fixnum ] [ ] ] "infer-effect" set-word-prop
-\ gc-time [ [ string ] [ ] ] "infer-effect" set-word-prop
+\ gc [ [ integer ] [ ] ] "infer-effect" set-word-prop
+\ gc-time [ [ ] [ integer ] ] "infer-effect" set-word-prop
 \ save-image [ [ string ] [ ] ] "infer-effect" set-word-prop
 \ exit [ [ integer ] [ ] ] "infer-effect" set-word-prop
 \ room [ [ ] [ integer integer integer integer array ] ] "infer-effect" set-word-prop
@@ -476,7 +476,7 @@ sequences strings vectors words prettyprint ;
 \ <array> [ [ integer object ] [ array ] ] "infer-effect" set-word-prop
 \ <array> t "flushable" set-word-prop
 
-\ <tuple> [ [ integer ] [ tuple ] ] "infer-effect" set-word-prop
+\ <tuple> [ [ integer word ] [ tuple ] ] "infer-effect" set-word-prop
 \ <tuple> t "flushable" set-word-prop
 
 \ begin-scan [ [ ] [ ] ] "infer-effect" set-word-prop

library/compiler/optimizer/class-infer.factor

@@ -109,7 +109,7 @@ M: node child-ties ( node -- seq )
         ] if
     ] if ;
 
-\ make-tuple [
+\ <tuple> [
     node-in-d first value-literal 1array
 ] "output-classes" set-word-prop
 

library/generic/tuple.factor

@@ -58,7 +58,7 @@ PREDICATE: word tuple-class "tuple-size" word-prop ;
     swap dup check-tuple-class [
         dup literalize ,
         "tuple-size" word-prop ,
-        \ make-tuple , %
+        \ <tuple> , %
     ] [ ] make define-compound ;
 
 : default-constructor ( tuple -- )

library/generic/tuple.facts

@@ -78,3 +78,12 @@ $terpri
 HELP: tuple>array "( tuple -- array )"
 { $values { "tuple" "a tuple" } { "array" "a new array" } }
 { $description "Outputs an array having the tuple's slots as elements. The first element is the tuple class word and the second is the delegate; the remainder are declared slots." } ;
+
+HELP: array>tuple "( array -- tuple )"
+{ $values { "array" "a array" } { "tuple" "a new tuple" } }
+{ $description "Outputs a tuple having the same slot values as the array." }
+{ $warning "This word is in the " { $snippet "kernel-internals" } " vocabulary since it is unsafe. Creating a tuple with the wrong shape can cause crashes or memory corruption. User code should construct tuples using generated tuple constructors instead; see " { $link "tuples" } "." } ;
+
+HELP: <tuple> "( class n -- tuple )"
+{ $values { "class" "a class word" } { "n" "a non-negative integer" } { "tuple" "a new tuple" } }
+{ $description "Low-level tuple constructor. User code should never call this directly, and instead use the constructor word which is defined for each tuple. See " { $link "tuples" } "." } ;

library/kernel.factor

@@ -74,8 +74,6 @@ IN: kernel-internals
 : array-nth swap 2 fixnum+fast slot ; inline
 : set-array-nth swap 2 fixnum+fast set-slot ; inline
 
-: make-tuple <tuple> [ 2 set-slot ] keep ; flushable
-
 ! Some runtime implementation details
 : num-types 19 ; inline
 : tag-mask BIN: 111 ; inline

library/kernel.facts

@@ -50,6 +50,10 @@ HELP: set-callstack "( cs -- )"
 { $values { "cs" "a vector" } }
 { $description "Replaces the call stack contents with a copy of a vector. The end of the vector becomes the top of the stack. The current quotation continues executing. The new callstack takes effect when the current quotation returns, resulting in a callframe being popped." } ;
 
+HELP: (clone) "( obj -- newobj )"
+{ $values { "obj" "an object" } { "newobj" "a shallow copy" } }
+{ $description "Outputs a byte-by-byte copy of the given object. User code should call " { $link clone } " instead." } ;
+
 HELP: clear "( -- )"
 { $description "Clears the data stack." } ;
 

library/math/complex.facts

@@ -67,3 +67,7 @@ HELP: complex/ "( x y -- r i m )"
         "m = yr*yr+yi*yi"
     }
 } ;
+
+HELP: <complex> "( x y -- z )"
+{ $values { "x" "a real number" } { "y" "a real number" } { "z" "a complex number" } }
+{ $description "Low-level complex number constructor. User code should call " { $link rect> } " instead." } ;

library/math/integer.facts

@@ -37,3 +37,84 @@ HELP: next-power-of-2 "( m -- n )"
 HELP: fraction> "( a b -- a/b )"
 { $values { "a" "an integer" } { "b" "a positive integer" } { "a/b" "a rational number" } }
 { $description "Creates a new ratio, or outputs the numerator if the denominator is 1. This word does not reduce the fraction to lowest terms, and should not be called directly; use " { $link / } " instead." } ;
+
+! Unsafe primitives
+HELP: bignum+ "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link + } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link + } " instead." } ;
+
+HELP: bignum- "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link - } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link - } " instead." } ;
+
+HELP: bignum* "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link * } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link * } " instead." } ;
+
+HELP: bignum/f "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a float" } }
+{ $description "Primitive version of " { $link /f } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link /f } " instead." } ;
+
+HELP: bignum/i "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link /i } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link /i } " instead." } ;
+
+HELP: bignum-mod "( x y -- z w )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } { "w" "a bignum" } }
+{ $description "Primitive version of " { $link mod } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link mod } " instead." } ;
+
+HELP: bignum/mod "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link /mod } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link /mod } " instead." } ;
+
+HELP: bignum< "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link < } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link < } " instead." } ;
+
+HELP: bignum<= "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link <= } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link <= } " instead." } ;
+
+HELP: bignum> "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link > } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link > } " instead." } ;
+
+HELP: bignum>= "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link >= } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link >= } " instead." } ;
+
+HELP: bignum= "( x y -- ? )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link number= } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link number= } " instead." } ;
+
+HELP: bignum-bitand "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link bitand } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link bitand } " instead." } ;
+
+HELP: bignum-bitor "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link bitor } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link bitor } " instead." } ;
+
+HELP: bignum-bitxor "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link bitxor } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link bitxor } " instead." } ;
+
+HELP: bignum-shift "( x y -- z )"
+{ $values { "x" "a bignum" } { "y" "a bignum" } { "z" "a bignum" } }
+{ $description "Primitive version of " { $link shift } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link shift } " instead." } ;

library/math/ratio.facts

@@ -21,3 +21,7 @@ HELP: >fraction "( a/b -- a b )"
 HELP: 2>fraction "( a/b c/d -- a c b d )"
 { $values { "a/b" "a rational number" } { "a" "an integer" } { "c" "an integer" } { "b" "a positive integer" } { "d" "a positive integer" } }
 { $description "Extracts the numerator and denominator of two rational numbers at once." } ;
+
+HELP: (fraction>) "( a b -- a/b )"
+{ $values { "a" "an integer" } { "b" "an integer" } { "a/b" "a ratio" } }
+{ $description "Low-level ratio constructor. User code should call " { $link / } " to create ratios instead." } ;

library/quotations.facts

@@ -1,20 +1,25 @@
 IN: kernel
 USING: arrays help strings vectors ;
 
+HELP: <quotation> "( n -- quot )"
+{ $values { "n" "a non-negative integer" } { "quot" "a new quotation" } }
+{ $description "Creates a new quotation with the given length and all elements initially set to " { $link f } "." }
+{ $see-also <array> <string> <sbuf> <vector> } ;
+
 HELP: >quotation "( seq -- quot )"
 { $values { "seq" "a sequence" } { "quot" "a quotation" } }
 { $description "Outputs a freshly-allocated quotation with the same elements as a given sequence." }
 { $see-also >array >string >sbuf >vector } ;
 
 HELP: make-dip "( quot n -- newquot )"
-{ $values { "quot" "a quotation" } { "n" "a non-negative integer" } { "newquot" "a quotation" } }
+{ $values { "quot" "a quotation" } { "n" "a non-negative integer" } { "newquot" "a new quotation" } }
 { $description "Constructs a quotation which retains the top " { $snippet "n" } " stack items, and applies " { $snippet "quot" } " to what is underneath." }
 { $examples
     { $example "[ 3 + ] 2 make-dip ." "[ >r >r 3 + r> r> ]" }
 } ;
 
 HELP: unit "( obj -- quot )"
-{ $values { "obj" "an object" } { "quot" "a quotation" } }
+{ $values { "obj" "an object" } { "quot" "a new quotation" } }
 { $description "Constructs a quotation holding one element." }
 { $notes
     "The following two phrases are equivalent:"
@@ -23,6 +28,10 @@ HELP: unit "( obj -- quot )"
 }
 { $see-also 1array } ;
 
+HELP: <wrapper> "( obj -- wrapper )"
+{ $values { "obj" "an object" } { "wrapper" "a new wrapper" } }
+{ $description "Creates an object which pushes " { $snippet "obj" } " on the stack when evaluated. User code should call " { $link literalize } " instead, since it avoids wrapping self-evaluating objects (which is redundant)." } ;
+
 HELP: literalize "( obj -- wrapped )"
 { $values { "obj" "an object" } { "wrapped" "an object" } }
 { $description "Outputs an object which evaluates to " { $snippet "obj" } ". If " { $snippet "obj" } " is not self-evaluating (for example, it is a word), then it will be wrapped." }
@@ -41,6 +50,6 @@ HELP: curry "( obj quot -- newquot )"
 } ;
 
 HELP: alist>quot "( default assoc -- quot )"
-{ $values { "default" "a quotation" } { "assoc" "a sequence of quotation pairs" } { "quot" "a quotation" } }
+{ $values { "default" "a quotation" } { "assoc" "a sequence of quotation pairs" } { "quot" "a new quotation" } }
 { $description "Constructs a quotation which calls the first quotation in each pair of " { $snippet "assoc" } " until one of them outputs a true value, and then calls the second quotation in the corresponding pair. Quotations are called in reverse order, and if no quotation outputs a true value then " { $snippet "default" } " is called." }
 { $notes "This word is used to implement compile-time behavior for " { $link cond } ", and it is also used by the generic word system. Note that unlike " { $link cond } ", the constructed quotation performs the tests starting from the end and not the beginning." } ;

library/words.facts

@@ -1,4 +1,4 @@
-USING: help inspector kernel parser words ;
+USING: help inspector kernel kernel-internals parser words ;
 
 HELP: execute "( word -- )"
 { $values { "word" "a word" } }
@@ -139,6 +139,10 @@ HELP: reset-generic "( word -- )"
 { $description "Reset word declarations and generic word properties." }
 $low-level-note ;
 
+HELP: (word) "( name vocab -- word )"
+{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
+{ $description "Low-level word constructor. User code should call " { $link <word> } " instead." } ;
+
 HELP: <word> "( name vocab -- word )"
 { $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
 { $description "Creates an uninterned word with the specified name and vocabulary. Note that this does not create the vocabulary, nor does it add the word to an existing vocabulary with that name. In most cases, " { $link create } " should be used instead." } ;

native/array.c

@@ -45,9 +45,15 @@ void primitive_array(void)
 /* push a new tuple on the stack */
 void primitive_tuple(void)
 {
-	F_FIXNUM size = to_fixnum(dpop());
-	maybe_gc(array_size(size));
-	dpush(tag_object(array(TUPLE_TYPE,size,F)));
+	CELL class;
+	F_FIXNUM size;
+	F_ARRAY *tuple;
+	maybe_gc(0);
+	size = to_fixnum(dpop());
+	class = dpop();
+	tuple = array(TUPLE_TYPE,size,F);
+	put(AREF(tuple,0),class);
+	dpush(tag_object(tuple));
 }
 
 /* push a new byte on the stack */