tuple documentation; rename array>tuple to >tuple
Slava Pestov
parent
9d1f07cf0e
commit
573c419211
|
|
@ -224,6 +224,7 @@ vectors words ;
|
|||
"/library/generic/math-combination.facts"
|
||||
"/library/generic/slots.facts"
|
||||
"/library/generic/standard-combination.facts"
|
||||
"/library/generic/tuple.facts"
|
||||
"/library/syntax/parse-stream.facts"
|
||||
"/library/syntax/parser.facts"
|
||||
"/library/syntax/parse-syntax.facts"
|
||||
|
|
|
|||
|
|
@ -257,7 +257,7 @@ M: string ' ( string -- pointer )
|
|||
: transfer-tuple ( tuple -- tuple )
|
||||
tuple>array
|
||||
dup first transfer-word 0 pick set-nth
|
||||
array>tuple ;
|
||||
>tuple ;
|
||||
|
||||
M: tuple ' ( tuple -- pointer )
|
||||
transfer-tuple
|
||||
|
|
|
|||
|
|
@ -218,7 +218,7 @@ call
|
|||
{ "expired?" "alien" }
|
||||
{ "<wrapper>" "kernel" }
|
||||
{ "(clone)" "kernel-internals" }
|
||||
{ "(array>tuple)" "kernel-internals" }
|
||||
{ "array>tuple" "kernel-internals" }
|
||||
{ "tuple>array" "generic" }
|
||||
{ "array>vector" "vectors" }
|
||||
{ "<string>" "strings" }
|
||||
|
|
|
|||
|
|
@ -13,14 +13,6 @@ USING: arrays errors hashtables kernel lists math namespaces parser sequences se
|
|||
|
||||
IN: generic
|
||||
|
||||
! Tuples are really arrays in the runtime, but with a different
|
||||
! type number. The layout is as follows:
|
||||
|
||||
! slot 0 - object header with type number (as usual)
|
||||
! slot 1 - length, including class/delegate slots
|
||||
! slot 2 - the class, a word
|
||||
! slot 3 - the delegate tuple, or f
|
||||
|
||||
: class ( object -- class )
|
||||
dup tuple? [ 2 slot ] [ type type>class ] if ; inline
|
||||
|
||||
|
|
@ -28,8 +20,6 @@ IN: generic
|
|||
dup tuple? [ 2 slot ] [ drop f ] if ; inline
|
||||
|
||||
: tuple-predicate ( word -- )
|
||||
#! Make a foo? word for testing the tuple class at the top
|
||||
#! of the stack.
|
||||
dup predicate-word
|
||||
[ \ class-tuple , over literalize , \ eq? , ] [ ] make
|
||||
define-predicate ;
|
||||
|
|
@ -38,8 +28,6 @@ IN: generic
|
|||
dup forget "predicate" word-prop car [ forget ] when* ;
|
||||
|
||||
: check-shape ( word slots -- )
|
||||
#! If the new list of slots is different from the previous,
|
||||
#! forget the old definition.
|
||||
>r in get lookup dup [
|
||||
dup "tuple-size" word-prop r> length 2 + =
|
||||
[ drop ] [ forget-tuple ] if
|
||||
|
|
@ -56,9 +44,6 @@ IN: generic
|
|||
2dup delegate-slots swap append "slots" set-word-prop
|
||||
define-slots ;
|
||||
|
||||
: tuple-constructor ( class -- word )
|
||||
word-name in get constructor-word dup save-location ;
|
||||
|
||||
PREDICATE: word tuple-class "tuple-size" word-prop ;
|
||||
|
||||
: check-tuple-class ( class -- )
|
||||
|
|
@ -70,7 +55,7 @@ PREDICATE: word tuple-class "tuple-size" word-prop ;
|
|||
] [ ] make r> append define-compound ;
|
||||
|
||||
: default-constructor ( tuple -- )
|
||||
[ tuple-constructor ] keep dup [
|
||||
[ create-constructor ] keep dup [
|
||||
"slots" word-prop 1 swap tail-slice reverse-slice
|
||||
[ peek unit , \ keep , ] each
|
||||
] [ ] make define-constructor ;
|
||||
|
|
@ -86,29 +71,22 @@ PREDICATE: word tuple-class "tuple-size" word-prop ;
|
|||
default-constructor ;
|
||||
|
||||
M: tuple clone ( tuple -- tuple )
|
||||
#! Clone a tuple and its delegate.
|
||||
(clone) dup delegate clone over set-delegate ;
|
||||
|
||||
M: tuple hashcode ( vec -- n )
|
||||
#! Poor.
|
||||
array-capacity ;
|
||||
M: tuple hashcode ( vec -- n ) array-capacity ;
|
||||
|
||||
M: tuple = ( obj tuple -- ? )
|
||||
2dup eq? [
|
||||
2drop t
|
||||
] [
|
||||
over tuple? [ tuple= ] [ 2drop f ] if
|
||||
] if ;
|
||||
2dup eq?
|
||||
[ 2drop t ] [ over tuple? [ tuple= ] [ 2drop f ] if ] if ;
|
||||
|
||||
: is? ( obj pred -- ? | pred: obj -- ? )
|
||||
#! Tests if the object satisfies the predicate, or if
|
||||
#! it delegates to an object satisfying it.
|
||||
[ call ] 2keep rot [
|
||||
2drop t
|
||||
over [
|
||||
2dup >r >r call
|
||||
[ r> r> 2drop t ] [ r> delegate r> is? ] if
|
||||
] [
|
||||
over [ >r delegate r> is? ] [ 2drop f ] if
|
||||
2drop f
|
||||
] if ; inline
|
||||
|
||||
: array>tuple ( seq -- tuple )
|
||||
: >tuple ( seq -- tuple )
|
||||
>vector dup first "tuple-size" word-prop over set-length
|
||||
>array (array>tuple) ;
|
||||
>array array>tuple ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,80 @@
|
|||
USING: generic help kernel kernel-internals ;
|
||||
|
||||
HELP: tuple= "( tuple1 tuple2 -- ? )"
|
||||
{ $values { "tuple1" "a tuple" } { "tuple2" "a tuple" } }
|
||||
{ $description "Low-level tuple equality test. Client code should use " { $link = } " instead." }
|
||||
{ $warning "This word is in the " { $snippet "kernel-internals" } " vocabulary because it does not do any type checking. Passing values which are not tuples can result in memory corruption." } ;
|
||||
|
||||
HELP: tuple f
|
||||
{ $description "The class of tuples. This class is further partitioned into disjoint subclasses; each tuple shape defined by " { $link POSTPONE: TUPLE: } " is a new class."
|
||||
$terpri
|
||||
"Tuple classes have additional word properties:"
|
||||
{ $list
|
||||
{ { $snippet "\"slot-names\"" } " - a sequence of strings naming the tuple's slots" }
|
||||
{ { $snippet "\"tuple-size\"" } " - the number of slots" }
|
||||
} }
|
||||
{ $notes "Low-level facilities need to be aware of tuple object layout. It is of no concern to client code. The layout of a tuple in memory is straightforward:"
|
||||
{ $list
|
||||
"slot 0 - object header with type number (as usual)"
|
||||
"slot 1 - number of slots, include class and delegate"
|
||||
"slot 2 - the tuple's class word"
|
||||
{ "slot 3 - a delegate or " { $link f } }
|
||||
} } ;
|
||||
|
||||
HELP: class "( object -- class )"
|
||||
{ $values { "object" "an object" } { "class" "a class word" } }
|
||||
{ $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either the built-in class, or if the object is a tuple, the tuple class." }
|
||||
{ $examples { $example "1.0 class ." "float" } { $example "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
|
||||
|
||||
HELP: tuple-predicate "( class -- )"
|
||||
{ $values { "class" "a tuple class word" } }
|
||||
{ $description "Defines a predicate word that tests if the top of the stack is an instance of " { $snippet class } ". This will only work if " { $snippet class } " is a tuple class." }
|
||||
$low-level-note ;
|
||||
|
||||
HELP: check-shape "( class slots -- )"
|
||||
{ $values { "class" "a tuple class word" } { "slots" "a sequence of strings" } }
|
||||
{ $description "If the new slot list does not have the same length as the current slot list for " { $snippet "class" } ", removes the class word from the dictionary. This allows a new class to be defined, and instances of the old class and the new class can co-exist, with new instances having a different number of slots. This prevents memory corruption if old accessors are called on new instances, or vice versa."
|
||||
$terpri
|
||||
"If " { $snippet "class" } " is not a tuple class word, or if no slots are being added or removed, this word does nothing. In this case, it is safe to redefine the class, and have the same set of accessor words operate on old and new instances." }
|
||||
$low-level-note ;
|
||||
|
||||
HELP: tuple-slots "( class slots -- )"
|
||||
{ $values { "class" "a tuple class word" } { "slots" "a sequence of strings" } }
|
||||
{ $description "Defines slot accessor and mutator words for the tuple." }
|
||||
$low-level-note ;
|
||||
|
||||
HELP: tuple-class f
|
||||
{ $description "The class of tuple class words." }
|
||||
{ $examples { $example "TUPLE: name title first last ;\nname tuple-class? ." "t" } } ;
|
||||
|
||||
HELP: define-constructor "( word class def -- )"
|
||||
{ $values { "word" "a constructor word" } { "class" "a tuple class word" } { "def" "a quotation" } }
|
||||
{ $description "Define a constructor word for a tuple class. The constructor definition receives a new instance of the class on the stack, with all slots initially set to " { $link f } "." }
|
||||
{ $see-also POSTPONE: C: } ;
|
||||
|
||||
HELP: default-constructor "( class -- )"
|
||||
{ $values { "class" "a tuple class word" } }
|
||||
{ $description "Defines the default constructor for a tuple class. The default constructor fills slot values in from the stack." }
|
||||
{ $examples { $example "TUPLE: account type balance ;\n\"savings\" 100 <account> ." "T{ account f \"savings\" 100 }" } } ;
|
||||
|
||||
HELP: define-tuple "( class slots -- )"
|
||||
{ $values { "class" "a new word" } { "slots" "a sequence of strings" } }
|
||||
{ $description "Defines a tuple class with slots named by " { $snippet "slots" } "." }
|
||||
{ $see-also POSTPONE: TUPLE: } ;
|
||||
|
||||
HELP: is? "( obj quot -- ? )"
|
||||
{ $values { "obj" "an object" } { "quot" "a quotation with stack effect " { $snippet "( obj -- ? )" } } { "?" "a boolean" } }
|
||||
{ $description "Tests if the object or one of its delegates satisfies the predicate quotation."
|
||||
$terpri
|
||||
"Class membership test pridicates only test if an object is a direct instance of that class. Sometimes, you need to check delegates, since this gives a clearer picture of what operations the object supports." } ;
|
||||
|
||||
HELP: >tuple "( seq -- tuple )"
|
||||
{ $values { "seq" "a sequence" } { "tuple" "a new tuple" } }
|
||||
{ $description "Creates a tuple with slot values taken from a sequence. The first element of the sequence must be a tuple class word, the second a delegate, and the remainder the declared slots."
|
||||
$terpri
|
||||
"If the sequence has too many elements, they are ignored, and if it has too few, the remaining slots in the tuple are set to " { $link f } "." }
|
||||
{ $errors "Throws an error if the first element of the sequence is not a tuple class word." } ;
|
||||
|
||||
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." } ;
|
||||
|
|
@ -496,8 +496,8 @@ sequences strings vectors words prettyprint ;
|
|||
\ (clone) [ [ object ] [ object ] ] "infer-effect" set-word-prop
|
||||
\ (clone) t "flushable" set-word-prop
|
||||
|
||||
\ (array>tuple) [ [ array ] [ tuple ] ] "infer-effect" set-word-prop
|
||||
\ (array>tuple) t "flushable" set-word-prop
|
||||
\ array>tuple [ [ array ] [ tuple ] ] "infer-effect" set-word-prop
|
||||
\ array>tuple t "flushable" set-word-prop
|
||||
|
||||
\ tuple>array [ [ tuple ] [ array ] ] "infer-effect" set-word-prop
|
||||
\ tuple>array t "flushable" set-word-prop
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: help kernel kernel-internals sequences ;
|
||||
USING: generic help kernel kernel-internals sequences ;
|
||||
|
||||
HELP: eq? "( obj1 obj2 -- ? )"
|
||||
{ $values { "obj1" "an object" } { "obj2" "an object" } }
|
||||
|
|
@ -105,6 +105,11 @@ HELP: num-types "( -- n )"
|
|||
{ $values { "n" "a postiive integer" } }
|
||||
{ $description "Outputs one more than the maximum value from the " { $link type } " primitive." } ;
|
||||
|
||||
HELP: type "( object -- n )"
|
||||
{ $values { "object" "an object" } { "n" "a type number" } }
|
||||
{ $description "Outputs an object's type number. Often, the " { $link class } " word is more useful." }
|
||||
{ $see-also type>class } ;
|
||||
|
||||
HELP: ? "( cond true false -- true/false )"
|
||||
{ $values { "cond" "a generalized boolean" } { "true" "an object" } { "false" "an object" } { "true/false" "one two input objects" } }
|
||||
{ $description "Chooses between two values depending on the boolean value of " { $snippet "cond" } "." } ;
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ SYMBOL: t
|
|||
: V{ [ >vector ] [ ] ; parsing
|
||||
: H{ [ alist>hash ] [ ] ; parsing
|
||||
: C{ [ first2 rect> ] [ ] ; parsing
|
||||
: T{ [ array>tuple ] [ ] ; parsing
|
||||
: T{ [ >tuple ] [ ] ; parsing
|
||||
: W{ [ first <wrapper> ] [ ] ; parsing
|
||||
: POSTPONE: scan-word swons ; parsing
|
||||
: \ scan-word literalize swons ; parsing
|
||||
|
|
|
|||
|
|
@ -97,7 +97,7 @@ HELP: : "word definition... ;"
|
|||
{ $values { "word" "a new word to define" } { "definition" "a word definition" } }
|
||||
{ $description "Defines a compound word in the current vocabulary." }
|
||||
{ $examples { $code ": ask-name ( -- name )\n \"What is your name? \" write readln ;\n: greet ( name -- ) \"Greetings, \" write print ;\n: friend ( -- ) ask-name greet ;" } }
|
||||
{ $see-also POSTPONE: ; } ;
|
||||
{ $see-also POSTPONE: ; define-compound } ;
|
||||
|
||||
HELP: ; ""
|
||||
{ $description
|
||||
|
|
@ -198,21 +198,25 @@ HELP: GENERIC: "word"
|
|||
$terpri
|
||||
"This parsing word is equivalent to the following usage of the more general " { $link POSTPONE: G: } " word:"
|
||||
{ $code "G: word simple-combination ;" }
|
||||
} ;
|
||||
}
|
||||
{ $see-also define-generic } ;
|
||||
|
||||
HELP: G: "word combination... ;"
|
||||
{ $values { "word" "a new word to define" } { "combination" "a method combination definition with stack effect " { $snippet "( word -- quot )" } } }
|
||||
{ $description "Defines a generic word using the long-form. A method combination is a quotation that is given the generic word on the stack, and outputs a quotation " { $emphasis "that becomes the definition of the word" } "." }
|
||||
{ $contract "The method combination quotation is called each time the generic word has to be updated (for example, when a method is added), and thus must be side-effect free." } ;
|
||||
{ $contract "The method combination quotation is called each time the generic word has to be updated (for example, when a method is added), and thus must be side-effect free." }
|
||||
{ $see-also define-generic* } ;
|
||||
|
||||
HELP: M: "class generic definition... ;"
|
||||
{ $values { "class" "a class word" } { "generic" "a generic word" } { "definition" "a method definition" } }
|
||||
{ $description "Defines a method, that is, a behavior for the generic word specialized on instances of the class." } ;
|
||||
{ $description "Defines a method, that is, a behavior for the generic word specialized on instances of the class." }
|
||||
{ $see-also define-method } ;
|
||||
|
||||
HELP: UNION: "class members... ;"
|
||||
{ $values { "class" "a new class word to define" } { "members" "a list of class words separated by whitespace" } }
|
||||
{ $description "Defines a union class. An object is an instance of a union class if it is an instance of one of its members." }
|
||||
{ $notes "Union classes are used to associate the same method with several different classes, as well as to conveniently define predicates." } ;
|
||||
{ $notes "Union classes are used to associate the same method with several different classes, as well as to conveniently define predicates." }
|
||||
{ $see-also define-union } ;
|
||||
|
||||
HELP: PREDICATE: "superclass class predicate... ;"
|
||||
{ $values { "superclass" "an existing class word" } { "class" "a new class word to define" } { "predicate" "membership test with stack effect " { $snippet "( superclass -- ? )" } } }
|
||||
|
|
@ -225,13 +229,15 @@ HELP: PREDICATE: "superclass class predicate... ;"
|
|||
"it satisfies the predicate"
|
||||
}
|
||||
"Each predicate must be defined as a subclass of some other class. This ensures that predicates inheriting from disjoint classes do not need to be exhaustively tested during method dispatch."
|
||||
} ;
|
||||
}
|
||||
{ $see-also define-predicate-class } ;
|
||||
|
||||
HELP: TUPLE: "class slots... ;"
|
||||
{ $values { "class" "a new class word to define" } { "slots" "a list of slot names" } }
|
||||
{ $description "Defines a new tuple class with membership predicate " { $snippet "name?" } " and constructor " { $snippet "<name>" } "."
|
||||
$terpri
|
||||
"Tuples are user-defined classes with instances composed of named slots. All tuple classes are subtypes of the built-in " { $link tuple } " type." } ;
|
||||
"Tuples are user-defined classes with instances composed of named slots. All tuple classes are subtypes of the built-in " { $link tuple } " type." }
|
||||
{ $see-also define-tuple } ;
|
||||
|
||||
HELP: C: "class definition... ;"
|
||||
{ $values { "class" "a class word" } { "generic" "a generic word" } { "definition" "a constructor definition" } }
|
||||
|
|
@ -239,4 +245,5 @@ HELP: C: "class definition... ;"
|
|||
$terpri
|
||||
"Constructors are named after the tuple class surrounded in angle brackets: " { $snippet "<" } " and " { $snippet ">" } "." }
|
||||
{ $contract "The definition must only have one output, the new tuple itself." }
|
||||
{ $notes "Each tuple class defines a default constructor that reads slot values from the stack. This parsing word redefines the default constructor." } ;
|
||||
{ $notes "Each tuple class defines a default constructor that reads slot values from the stack. This parsing word redefines the default constructor." }
|
||||
{ $see-also define-constructor } ;
|
||||
|
|
|
|||
|
|
@ -62,6 +62,9 @@ C: parse-error ( error -- error )
|
|||
|
||||
: create-in in get create dup save-location ;
|
||||
|
||||
: create-constructor ( class -- word )
|
||||
word-name in get constructor-word dup save-location ;
|
||||
|
||||
: CREATE ( -- word ) scan create-in ;
|
||||
|
||||
SYMBOL: string-mode
|
||||
|
|
|
|||
|
|
@ -92,6 +92,10 @@ HELP: create-in "( word -- )"
|
|||
{ $description "Creates a word in the current vocabulary. Until re-defined, the word throws an error when invoked." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: create-constructor "( word -- constructor )"
|
||||
{ $values { "class" "a word" } { "constructor" "a new word" } }
|
||||
{ $description "Creates a new word in the current vocabulary, named by surrounding " { $link "word" } " with angle brackets." } ;
|
||||
|
||||
HELP: CREATE "( -- word )"
|
||||
{ $values { "word" "a word" } }
|
||||
{ $description "Reads the next token from the line currently being parsed, and creates a word with that name in the current vocabulary." }
|
||||
|
|
|
|||
Loading…
Reference in New Issue