Merge branch 'master' of git://factorcode.org/git/factor

core/alien/alien.factor

@@ -65,21 +65,21 @@ TUPLE: library path abi dll ;
 
 TUPLE: alien-callback return parameters abi quot xt ;
 
-TUPLE: alien-callback-error ;
+ERROR: alien-callback-error ;
 
 : alien-callback ( return parameters abi quot -- alien )
-    \ alien-callback-error construct-empty throw ;
+    alien-callback-error ;
 
 TUPLE: alien-indirect return parameters abi ;
 
-TUPLE: alien-indirect-error ;
+ERROR: alien-indirect-error ;
 
 : alien-indirect ( ... funcptr return parameters abi -- )
-    \ alien-indirect-error construct-empty throw ;
+    alien-indirect-error ;
 
 TUPLE: alien-invoke library function return parameters ;
 
-TUPLE: alien-invoke-error library symbol ;
+ERROR: alien-invoke-error library symbol ;
 
 : alien-invoke ( ... return library function parameters -- ... )
-    2over \ alien-invoke-error construct-boa throw ;
+    2over alien-invoke-error ;

core/alien/c-types/c-types.factor

@@ -26,9 +26,7 @@ global [
     c-types [ H{ } assoc-like ] change
 ] bind
 
-TUPLE: no-c-type name ;
+ERROR: no-c-type name ;
-
-: no-c-type ( type -- * ) \ no-c-type construct-boa throw ;
 
 : (c-type) ( name -- type/f )
     c-types get-global at dup [

core/bootstrap/compiler/compiler.factor

@@ -79,7 +79,7 @@ nl
 "." write flush
 
 {
-    malloc free memcpy
+    malloc calloc free memcpy
 } compile
 
 " done" print flush

core/combinators/combinators.factor

@@ -5,16 +5,12 @@ USING: arrays sequences sequences.private math.private
 kernel kernel.private math assocs quotations vectors
 hashtables sorting ;
 
-TUPLE: no-cond ;
+ERROR: no-cond ;
-
-: no-cond ( -- * ) \ no-cond construct-empty throw ;
 
 : cond ( assoc -- )
     [ first call ] find nip dup [ second call ] [ no-cond ] if ;
 
-TUPLE: no-case ;
+ERROR: no-case ;
-
-: no-case ( -- * ) \ no-case construct-empty throw ;
 
 : case ( obj assoc -- )
     [ dup array? [ dupd first = ] [ quotation? ] if ] find nip

core/debugger/debugger.factor

@@ -75,9 +75,7 @@ SYMBOL: error-hook
 : try ( quot -- )
     [ error-hook get call ] recover ;
 
-TUPLE: assert got expect ;
+ERROR: assert got expect ;
-
-: assert ( got expect -- * ) \ assert construct-boa throw ;
 
 : assert= ( a b -- ) 2dup = [ 2drop ] [ assert ] if ;
 
@@ -86,28 +84,22 @@ TUPLE: assert got expect ;
 : trim-datastacks ( seq1 seq2 -- seq1' seq2' )
     2dup [ length ] 2apply min tuck tail >r tail r> ;
 
-TUPLE: relative-underflow stack ;
+ERROR: relative-underflow stack ;
-
-: relative-underflow ( before after -- * )
-    trim-datastacks nip \ relative-underflow construct-boa throw ;
 
 M: relative-underflow summary
     drop "Too many items removed from data stack" ;
 
-TUPLE: relative-overflow stack ;
+ERROR: relative-overflow stack ;
 
 M: relative-overflow summary
     drop "Superfluous items pushed to data stack" ;
 
-: relative-overflow ( before after -- * )
-    trim-datastacks drop \ relative-overflow construct-boa throw ;
-
 : assert-depth ( quot -- )
     >r datastack r> swap slip >r datastack r>
     2dup [ length ] compare sgn {
-        { -1 [ relative-underflow ] }
+        { -1 [ trim-datastacks nip relative-underflow ] }
         { 0 [ 2drop ] }
-        { 1 [ relative-overflow ] }
+        { 1 [ trim-datastacks drop relative-overflow ] }
     } case ; inline
 
 : expired-error. ( obj -- )
@@ -210,13 +202,13 @@ M: no-method error.
 M: no-math-method summary
     drop "No suitable arithmetic method" ;
 
-M: check-closed summary
+M: stream-closed-twice summary
     drop "Attempt to perform I/O on closed stream" ;
 
 M: check-method summary
     drop "Invalid parameters for create-method" ;
 
-M: check-tuple summary
+M: no-tuple-class summary
     drop "Invalid class for define-constructor" ;
 
 M: no-cond summary
@@ -254,7 +246,7 @@ M: no-compilation-unit error.
 M: no-vocab summary
     drop "Vocabulary does not exist" ;
 
-M: check-ptr summary
+M: bad-ptr summary
     drop "Memory allocation failed" ;
 
 M: double-free summary

core/definitions/definitions.factor

@@ -3,10 +3,7 @@
 IN: definitions
 USING: kernel sequences namespaces assocs graphs ;
 
-TUPLE: no-compilation-unit definition ;
+ERROR: no-compilation-unit definition ;
-
-: no-compilation-unit ( definition -- * )
-    \ no-compilation-unit construct-boa throw ;
 
 GENERIC: where ( defspec -- loc )
 

core/generic/math/math.factor

@@ -33,10 +33,7 @@ PREDICATE: class math-class ( object -- ? )
     dup empty? [ [ dip ] curry [ ] like ] unless
     r> append ;
 
-TUPLE: no-math-method left right generic ;
+ERROR: no-math-method left right generic ;
-
-: no-math-method ( left right generic -- * )
-    \ no-math-method construct-boa throw ;
 
 : default-math-method ( generic -- quot )
     [ no-math-method ] curry [ ] like ;

core/generic/standard/standard.factor

@@ -26,10 +26,7 @@ SYMBOL: (dispatch#)
 
 : unpicker ( -- quot ) \ (dispatch#) get unpickers nth ;
 
-TUPLE: no-method object generic ;
+ERROR: no-method object generic ;
-
-: no-method ( object generic -- * )
-    \ no-method construct-boa throw ;
 
 : error-method ( word --  quot )
     picker swap [ no-method ] curry append ;

core/inference/inference-tests.factor

@@ -514,10 +514,10 @@ DEFER: an-inline-word
 
 { 0 1 } [ [ 2 ] [ 2 ] [ + ] compose compose call ] must-infer-as
 
-TUPLE: custom-error ;
+ERROR: custom-error ;
 
 [ T{ effect f 0 0 t } ] [
-    [ custom-error construct-boa throw ] infer
+    [ custom-error ] infer
 ] unit-test
 
 : funny-throw throw ; inline

core/inference/transforms/transforms.factor

@@ -64,14 +64,11 @@ M: pair (bitfield-quot) ( spec -- quot )
 
 \ get-slots [ [get-slots] ] 1 define-transform
 
-TUPLE: duplicated-slots-error names ;
+ERROR: duplicated-slots-error names ;
 
 M: duplicated-slots-error summary
     drop "Calling set-slots with duplicate slot setters" ;
 
-: duplicated-slots-error ( names -- * )
-    \ duplicated-slots-error construct-boa throw ;
-
 \ set-slots [
     dup all-unique?
     [ <reversed> [get-slots] ] [ duplicated-slots-error ] if

core/io/encodings/encodings.factor

@@ -18,17 +18,13 @@ GENERIC: <decoder> ( stream decoding -- newstream )
 
 TUPLE: decoder stream code cr ;
 
-TUPLE: decode-error ;
+ERROR: decode-error ;
-
-: decode-error ( -- * ) \ decode-error construct-empty throw ;
 
 GENERIC: <encoder> ( stream encoding -- newstream )
 
 TUPLE: encoder stream code ;
 
-TUPLE: encode-error ;
+ERROR: encode-error ;
-
-: encode-error ( -- * ) \ encode-error construct-empty throw ;
 
 ! Decoding
 

core/io/files/files.factor

@@ -48,10 +48,7 @@ M: object root-directory? ( path -- ? ) path-separator? ;
 
 : special-directory? ( name -- ? ) { "." ".." } member? ;
 
-TUPLE: no-parent-directory path ;
+ERROR: no-parent-directory path ;
-
-: no-parent-directory ( path -- * )
-    \ no-parent-directory construct-boa throw ;
 
 : parent-directory ( path -- parent )
     right-trim-separators {

core/io/io-tests.factor

@@ -28,15 +28,6 @@ IN: io.tests
 ! Make sure we use correct to_c_string form when writing
 [ ] [ "\0" write ] unit-test
 
-[ "" ] [ 0 read ] unit-test
-
-! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
-
-[
-    "/core/io/test/binary.txt" <resource-reader>
-    [ 0.2 read ] with-stream
-] must-fail
-
 [
     {
         { "It seems " CHAR: J }
@@ -58,3 +49,12 @@ IN: io.tests
         10 [ 65536 read drop ] times
     ] with-file-reader
 ] unit-test
+
+! [ "" ] [ 0 read ] unit-test
+
+! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
+
+! [
+!     "/core/io/test/binary.txt" <resource-reader>
+!     [ 0.2 read ] with-stream
+! ] must-fail

core/io/streams/duplex/duplex.factor

@@ -11,11 +11,10 @@ TUPLE: duplex-stream in out closed? ;
 : <duplex-stream> ( in out -- stream )
     f duplex-stream construct-boa ;
 
-TUPLE: check-closed ;
+ERROR: stream-closed-twice ;
 
 : check-closed ( stream -- )
-    duplex-stream-closed?
+    duplex-stream-closed? [ stream-closed-twice ] when ;
-    [ \ check-closed construct-boa throw ] when ;
 
 : duplex-stream-in+ ( duplex -- stream )
     dup check-closed duplex-stream-in ;

core/libc/libc.factor

@@ -23,20 +23,14 @@ SYMBOL: mallocs
 
 PRIVATE>
 
-TUPLE: check-ptr ;
+ERROR: bad-ptr ;
 
 : check-ptr ( c-ptr -- c-ptr )
-    [ \ check-ptr construct-boa throw ] unless* ;
+    [ bad-ptr ] unless* ;
 
-TUPLE: double-free ;
+ERROR: double-free ;
 
-: double-free ( -- * )
+ERROR: realloc-error ptr size ;
-    \ double-free construct-empty throw ;
-
-TUPLE: realloc-error ptr size ;
-
-: realloc-error ( alien size -- * )
-    \ realloc-error construct-boa throw ;
 
 <PRIVATE
 

core/mirrors/mirrors-docs.factor

@@ -2,14 +2,17 @@ USING: help.markup help.syntax slots kernel assocs sequences ;
 IN: mirrors
 
 ARTICLE: "mirrors" "Mirrors"
-"A reflective view of an object's slots and their values:"
+"The " { $vocab-link "mirrors" } " vocabulary defines data types which present an object's slots and slot values as an associative structure. This enables idioms such as iteration over all slots in a tuple, or editing of tuples, sequences and assocs in a generic fashion. This functionality is used by developer tools and meta-programming utilities."
+$nl
+"A mirror provides such a view of a tuple:"
 { $subsection mirror }
 { $subsection <mirror> }
-"A view of a sequence as an associative structure:"
+"An enum provides such a view of a sequence:"
 { $subsection enum }
 { $subsection <enum> }
 "Utility word used by developer tools which inspect objects:"
-{ $subsection make-mirror } ;
+{ $subsection make-mirror }
+{ $see-also "slots" } ;
 
 ABOUT: "mirrors"
 

core/parser/parser.factor

@@ -98,10 +98,7 @@ M: lexer skip-word ( lexer -- )
 
 : scan ( -- str/f ) lexer get parse-token ;
 
-TUPLE: bad-escape ;
+ERROR: bad-escape ;
-
-: bad-escape ( -- * )
-    \ bad-escape construct-empty throw ;
 
 M: bad-escape summary drop "Bad escape code" ;
 
@@ -215,10 +212,7 @@ SYMBOL: in
 : set-in ( name -- )
     check-vocab-string dup in set create-vocab (use+) ;
 
-TUPLE: unexpected want got ;
+ERROR: unexpected want got ;
-
-: unexpected ( want got -- * )
-    \ unexpected construct-boa throw ;
 
 PREDICATE: unexpected unexpected-eof
     unexpected-got not ;
@@ -294,10 +288,7 @@ M: no-word summary
 : CREATE-METHOD ( -- method )
     scan-word bootstrap-word scan-word create-method-in ;
 
-TUPLE: staging-violation word ;
+ERROR: staging-violation word ;
-
-: staging-violation ( word -- * )
-    \ staging-violation construct-boa throw ;
 
 M: staging-violation summary
     drop
@@ -352,9 +343,7 @@ SYMBOL: lexer-factory
         ] if
     ] if ;
 
-TUPLE: bad-number ;
+ERROR: bad-number ;
-
-: bad-number ( -- * ) \ bad-number construct-boa throw ;
 
 : parse-base ( parsed base -- parsed )
     scan swap base> [ bad-number ] unless* parsed ;

core/sequences/sequences.factor

@@ -41,19 +41,14 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ;
 : bounds-check? ( n seq -- ? )
     length 1- 0 swap between? ; inline
 
-TUPLE: bounds-error index seq ;
+ERROR: bounds-error index seq ;
-
-: bounds-error ( n seq -- * )
-    \ bounds-error construct-boa throw ;
 
 : bounds-check ( n seq -- n seq )
     2dup bounds-check? [ bounds-error ] unless ; inline
 
 MIXIN: immutable-sequence
 
-TUPLE: immutable seq ;
+ERROR: immutable seq ;
-
-: immutable ( seq -- * ) \ immutable construct-boa throw ;
 
 M: immutable-sequence set-nth immutable ;
 
@@ -190,8 +185,7 @@ TUPLE: slice from to seq ;
 : collapse-slice ( m n slice -- m' n' seq )
     dup slice-from swap slice-seq >r tuck + >r + r> r> ; inline
 
-TUPLE: slice-error reason ;
+ERROR: slice-error reason ;
-: slice-error ( str -- * ) \ slice-error construct-boa throw ;
 
 : check-slice ( from to seq -- from to seq )
     pick 0 < [ "start < 0" slice-error ] when

core/slots/slots-docs.factor

@@ -4,21 +4,86 @@ effects generic.standard tuples slots.private classes
 strings math ;
 IN: slots
 
+ARTICLE: "accessors" "Slot accessors"
+"For each tuple slot, methods are defined on two accessor words in the " { $vocab-link "accessors" } " vocabulary:"
+{ $list
+    { "The " { $emphasis "reader" } " is named " { $snippet { $emphasis "slot" } ">>" } " and pushes the value of a slot on the stack." }
+    { "The " { $emphasis "writer" } " is named " { $snippet "(>>" { $emphasis "slot" } ")" } " and stores a value into a slot. It has stack effect " { $snippet "( value object -- )" } "." }
+}
+"In addition, two utility words are defined for each distinct slot name used in the system:"
+{ $list
+    { "The " { $emphasis "setter" } " is named " { $snippet "(>>" { $emphasis "slot" } ")" } " and stores a value into a slot. It has stack effect " { $snippet "( object value -- object )" } "." }
+    { "The " { $emphasis "changer" } " is named " { $snippet "change-" { $emphasis "slot" } } ". It applies a quotation to the current slot value and stores the result back in the slot; it has stack effect " { $snippet "( object quot -- object )" } "." }
+}
+"Since the reader and writer are generic, words can be written which do not depend on the specific class of tuple passed in, but instead work on any tuple that defines slots with certain names."
+$nl
+"In most cases, using the setter is preferred over the writer because the stack effect is better suited to the common case where the tuple is needed again, and where the new slot value was just computed and so is at the top of the stack. For example, consider the case where you want to create a tuple and fill in the slots with literals. The following version uses setters:"
+{ $code
+    "<email>"
+    "    \"Happy birthday\" >>subject"
+    "    { \"bob@bigcorp.com\" } >>to"
+    "    \"alice@bigcorp.com\" >>from"
+    "send-email"
+}
+"The following uses writers, and requires some stack shuffling:"
+{ $code
+    "<email>"
+    "    \"Happy birthday\" over (>>subject)"
+    "    { \"bob@bigcorp.com\" } over (>>to)"
+    "    \"alice@bigcorp.com\" over (>>from)"
+    "send-email"
+}
+"Even if some of the slot values come from the stack underneath the tuple being constructed, setters win:"
+{ $code
+    "<email>"
+    "    swap >>subject"
+    "    swap >>to"
+    "    \"alice@bigcorp.com\" >>from"
+    "send-email"
+}
+"This is because " { $link swap } " is easier to understand than " { $link tuck } ":"
+{ $code
+    "<email>"
+    "    tuck (>>subject)"
+    "    tuck (>>to)"
+    "    \"alice@bigcorp.com\" over (>>from)"
+    "send-email"
+}
+"The changer word abstracts a common pattern where a slot value is read then stored again; so the following is not idiomatic code:"
+{ $code
+    "find-manager"
+    "    salary>> 0.75 * >>salary"
+}
+"The following version is preferred:"
+{ $code
+    "find-manager"
+    "    [ 0.75 * ] change-salary"
+}
+{ $see-also "slots" "mirrors" } ;
+
 ARTICLE: "slots" "Slots"
-"A " { $emphasis "slot" } " is a component of an object which can store a value. The " { $vocab-link "slots" } " vocabulary contains words for introspecting the slots of an object."
+"A " { $emphasis "slot" } " is a component of an object which can store a value."
 $nl
 { $link "tuples" } " are composed entirely of slots, and instances of " { $link "builtin-classes" } " consist of slots together with intrinsic data."
+"The " { $vocab-link "slots" } " vocabulary contains words for introspecting the slots of an object."
 $nl
 "The " { $snippet "\"slots\"" } " word property of built-in and tuple classes holds an array of " { $emphasis "slot specifiers" } " describing the slot layout of each instance."
 { $subsection slot-spec }
-"Each slot has a reader word; mutable slots have an optional writer word. All tuple slots are mutable, but some slots on built-in classes are not."
+"The four words associated with a slot can be looked up in the " { $vocab-link "accessors" } " vocabulary:"
 { $subsection reader-word }
 { $subsection writer-word }
 { $subsection setter-word }
 { $subsection changer-word }
-"Slot methods type check, then call unsafe primitives:"
+"Looking up a slot by name:"
-{ $subsection slot }
+{ $subsection slot-named }
-{ $subsection set-slot } ;
+"Defining slots dynamically:"
+{ $subsection define-reader }
+{ $subsection define-writer }
+{ $subsection define-setter }
+{ $subsection define-changer }
+{ $subsection define-slot-methods }
+{ $subsection define-accessors }
+{ $see-also "accessors" "mirrors" } ;
 
 ABOUT: "slots"
 

core/syntax/syntax-docs.factor

@@ -556,10 +556,17 @@ HELP: PREDICATE:
 HELP: TUPLE:
 { $syntax "TUPLE: class slots... ;" }
 { $values { "class" "a new tuple class to define" } { "slots" "a list of slot names" } }
-{ $description "Defines a new tuple class with membership predicate " { $snippet "name?" } "."
+{ $description "Defines a new tuple class."
 $nl
 "Tuples are user-defined classes with instances composed of named slots. All tuple classes are subtypes of the built-in " { $link tuple } " type." } ;
 
+HELP: ERROR:
+{ $syntax "ERROR: class slots... ;" }
+{ $values { "class" "a new tuple class to define" } { "slots" "a list of slot names" } }
+{ $description "Defines a new tuple class.  Defines a new word " { $snippet "class?" } " that boa-constructs this tuple and throws it." } ;
+
+{ POSTPONE: ERROR: POSTPONE: TUPLE: } related-words
+
 HELP: C:
 { $syntax "C: constructor class" }
 { $values { "constructor" "a new word to define" } { "class" tuple-class } }

core/syntax/syntax.factor

@@ -165,6 +165,7 @@ IN: bootstrap.syntax
 
     "ERROR:" [
         CREATE-CLASS dup ";" parse-tokens define-tuple-class
+        dup save-location
         dup [ construct-boa throw ] curry define
     ] define-syntax
 

core/tuples/tuples-docs.factor

@@ -3,11 +3,10 @@ tuples.private classes slots quotations words arrays
 generic.standard sequences definitions compiler.units ;
 IN: tuples
 
-ARTICLE: "tuple-constructors" "Constructors and slots"
+ARTICLE: "tuple-constructors" "Constructors"
-"Tuples are created by calling one of a number of words:"
+"Tuples are created by calling one of two words:"
 { $subsection construct-empty }
 { $subsection construct-boa }
-{ $subsection construct }
 "By convention, construction logic is encapsulated in a word named after the tuple class surrounded in angle brackets; for example, the constructor word for a " { $snippet "point" } " class might be named " { $snippet "<point>" } "."
 $nl
 "A shortcut for defining BOA constructors:"
@@ -19,18 +18,13 @@ $nl
     "C: <rgba> rgba"
     ": <rgba> color construct-boa ; ! identical to above"
     ""
-    ": <rgb>"
+    ": <rgb> f <rgba> ;"
-    "    { set-color-red set-color-green set-color-blue }"
-    "    color construct ;"
-    ": <rgb> f <rgba> ; ! identical to above"
     ""
     ": <color> construct-empty ;"
-    ": <color> { } color construct ; ! identical to above"
     ": <color> f f f f <rgba> ; ! identical to above"
-}
+} ;
-"After construction, slots are read and written using various automatically-defined words with names of the form " { $snippet { $emphasis "class-slot" } } " and " { $snippet "set-" { $emphasis "class-slot" } } "." ;
 
-ARTICLE: "tuple-delegation" "Delegation"
+ARTICLE: "tuple-delegation" "Tuple delegation"
 "If a generic word having the " { $link standard-combination } " method combination is called on a tuple for which it does not have an applicable method, the method call is forwarded to the tuple's " { $emphasis "delegate" } ". If no delegate is set, a " { $link no-method } " error is thrown."
 { $subsection delegate }
 { $subsection set-delegate }
@@ -48,7 +42,7 @@ $nl
     "{ 0 0 } 10 <ellipse> \"my-ellipse\" set"
     "{ 1 0 0 } <colored> \"my-shape\" set"
     "\"my-ellipse\" get \"my-shape\" get set-delegate"
-    "\"my-shape\" get dup colored-color swap ellipse-center .s"
+    "\"my-shape\" get dup color>> swap center>> .s"
     "{ 0 0 }\n{ 1 0 0 }"
 } ;
 
@@ -58,25 +52,90 @@ ARTICLE: "tuple-introspection" "Tuple introspection"
 { $subsection tuple>array }
 { $subsection tuple-slots }
 "Tuple classes can also be defined at run time:"
-{ $subsection define-tuple-class } ;
+{ $subsection define-tuple-class }
+{ $see-also "slots" "mirrors" } ;
+
+ARTICLE: "tuple-examples" "Tuple examples"
+"An example:"
+{ $code "TUPLE: employee name salary position ;" }
+"This defines a class word named " { $snippet "employee" } ", a predicate " { $snippet "employee?" } ", and the following slot accessors:"
+{ $table
+    { "Reader" "Writer" "Setter" "Changer" }
+    { { $snippet "name>>" }    { $snippet "(>>name)" }    { $snippet ">>name" }    { $snippet "change-name" }    }
+    { { $snippet "salary>>" } { $snippet "(>>salary)" } { $snippet ">>salary" } { $snippet "change-salary" } }
+    { { $snippet "position>>" }   { $snippet "(>>position)" }   { $snippet ">>position" }   { $snippet "change-position" }   }
+}
+"We can define a constructor which makes an empty employee:"
+{ $code ": <employee> ( -- employee )"
+    "    employee construct-empty ;" }
+"Or we may wish the default constructor to always give employees a starting salary:"
+{ $code
+    ": <employee> ( -- employee )"
+    "    employee construct-empty"
+    "        40000 >>salary ;"
+}
+"We can define more refined constructors:"
+{ $code
+    ": <manager> ( -- manager )"
+    "    <employee> \"project manager\" >>position ;" }
+"An alternative strategy is to define the most general BOA constructor first:"
+{ $code
+    ": <employee> ( name position -- person )"
+    "    40000 employee construct-boa ;"
+}
+"Now we can define more specific constructors:"
+{ $code
+    ": <manager> ( name -- person )"
+    "    \"manager\" <person> ;" }
+"An example using reader words:"
+{ $code
+    "TUPLE: check to amount number ;"
+    ""
+    "SYMBOL: checks"
+    ""
+    ": <check> ( to amount -- check )"
+    "    checks counter check construct-boa ;"
+    ""
+    ": biweekly-paycheck ( employee -- check )"
+    "    dup name>> swap salary>> 26 / <check> ;"
+}
+"An example of using a changer:"
+{ $code
+    ": positions"
+    "    {"
+    "        \"junior programmer\""
+    "        \"senior programmer\""
+    "        \"project manager\""
+    "        \"department manager\""
+    "        \"executive\""
+    "        \"CTO\""
+    "        \"CEO\""
+    "        \"enterprise Java world dictator\""
+    "    } ;"
+    ""
+    ": next-position ( role -- newrole )"
+    "    positions [ index 1+ ] keep nth ;"
+    ""
+    ": promote ( person -- person )"
+    "    [ 1.2 * ] change-salary"
+    "    [ next-position ] change-position ;"
+} ;
 
 ARTICLE: "tuples" "Tuples"
-"Tuples are user-defined classes composed of named slots. A parsing word defines tuple classes:"
+"Tuples are user-defined classes composed of named slots."
+{ $subsection "tuple-examples" }
+"A parsing word defines tuple classes:"
 { $subsection POSTPONE: TUPLE: }
-"An example:"
+"For each tuple class, several words are defined. First, there is the class word, a class predicate, and accessor words for each slot."
-{ $code "TUPLE: person name address phone ;" "C: <person> person" }
+$nl
-"This defines a class word named " { $snippet "person" } ", a predicate " { $snippet "person?" } ", a constructor named " { $snippet "<person>" } ", and the following reader/writer words:"
+"The class word is used for defining methods on the tuple class; it has the same name as the tuple class. The predicate is named " { $snippet { $emphasis "name" } "?" } ". Tuple slots are accessed via accessor words:"
-{ $table
+{ $subsection "accessors" }
-    { "Reader" "Writer" }
-    { { $snippet "person-name" }    { $snippet "set-person-name" }    }
-    { { $snippet "person-address" } { $snippet "set-person-address" } }
-    { { $snippet "person-phone" }   { $snippet "set-person-phone" }   }
-}
 "Initially, no specific words are defined for constructing new instances of the tuple. Constructors must be defined explicitly:"
 { $subsection "tuple-constructors" }
 "Further topics:"
 { $subsection "tuple-delegation" }
-{ $subsection "tuple-introspection" } ;
+{ $subsection "tuple-introspection" }
+"Tuple literal syntax is documented in " { $link "syntax-tuples" } "." ;
 
 ABOUT: "tuples"
 

core/tuples/tuples-tests.factor

@@ -236,7 +236,7 @@ C: <erg's-reshape-problem> erg's-reshape-problem
 
 [
     "IN: tuples.tests SYMBOL: not-a-class C: <not-a-class> not-a-class" eval
-] [ [ check-tuple? ] is? ] must-fail-with
+] [ [ no-tuple-class? ] is? ] must-fail-with
 
 ! Hardcore unit tests
 USE: threads

core/tuples/tuples.factor

@@ -89,11 +89,11 @@ PRIVATE>
     2dup define-slots
     define-accessors ;
 
-TUPLE: check-tuple class ;
+ERROR: no-tuple-class class ;
 
 : check-tuple ( class -- )
     dup tuple-class?
-    [ drop ] [ \ check-tuple construct-boa throw ] if ;
+    [ drop ] [ no-tuple-class ] if ;
 
 : define-tuple-class ( class slots -- )
     2dup check-shape

core/vocabs/vocabs.factor

@@ -59,16 +59,13 @@ M: f vocab-help ;
 : create-vocab ( name -- vocab )
     dictionary get [ <vocab> ] cache ;
 
-TUPLE: no-vocab name ;
+ERROR: no-vocab name ;
-
-: no-vocab ( name -- * )
-    vocab-name \ no-vocab construct-boa throw ;
 
 SYMBOL: load-vocab-hook ! ( name -- )
 
 : load-vocab ( name -- vocab )
     dup load-vocab-hook get call
-    dup vocab [ ] [ no-vocab ] ?if ;
+    dup vocab [ ] [ vocab-name no-vocab ] ?if ;
 
 : vocabs ( -- seq )
     dictionary get keys natural-sort ;

core/words/words.factor

@@ -21,9 +21,7 @@ M: word definer drop \ : \ ; ;
 
 M: word definition word-def ;
 
-TUPLE: undefined ;
+ERROR: undefined ;
-
-: undefined ( -- * ) \ undefined construct-empty throw ;
 
 PREDICATE: word deferred ( obj -- ? )
     word-def [ undefined ] = ;
@@ -189,12 +187,11 @@ M: word subwords drop f ;
     [ ] [ no-vocab ] ?if
     set-at ;
 
-TUPLE: check-create name vocab ;
+ERROR: bad-create name vocab ;
 
 : check-create ( name vocab -- name vocab )
-    2dup [ string? ] both? [
+    2dup [ string? ] both?
-        \ check-create construct-boa throw
+    [ bad-create ] unless ;
-    ] unless ;
 
 : create ( name vocab -- word )
     check-create 2dup lookup

extra/help/lint/lint.factor

@@ -39,8 +39,6 @@ IN: help.lint
     {
         $shuffle
         $values-x/y
-        $slot-reader
-        $slot-writer
         $predicate
         $class-description
         $error-description

extra/help/markup/markup-tests.factor

@@ -4,18 +4,6 @@ IN: help.markup.tests
 
 TUPLE: blahblah quux ;
 
-: test-slot blahblah "slots" word-prop second ;
-
-[
-    { { "blahblah" { $instance blahblah } } { "quux" { $instance object } } }
-] [
-    test-slot blahblah ($spec-reader-values)
-] unit-test
-
-[ ] [
-    test-slot blahblah $spec-reader-values
-] unit-test
-
 [ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
 
 [ ] [ \ blahblah-quux help ] unit-test

extra/math/ranges/ranges-docs.factor

@@ -0,0 +1,21 @@
+USING: help.syntax help.markup ;
+
+IN: math.ranges
+
+ARTICLE: "ranges" "Ranges"
+
+  "A " { $emphasis "range" } " is a virtual sequence with elements "
+  "ranging from a to b by step."
+
+  $nl
+
+  "Creating ranges:"
+
+  { $subsection <range> }
+  { $subsection [a,b]   }
+  { $subsection (a,b]   }
+  { $subsection [a,b)   }
+  { $subsection (a,b)   }
+  { $subsection [0,b]   }
+  { $subsection [1,b]   }
+  { $subsection [0,b)   } ;

extra/math/ranges/ranges.factor

@@ -3,7 +3,7 @@ IN: math.ranges
 
 TUPLE: range from length step ;
 
-: <range> ( from to step -- range )
+: <range> ( a b step -- range )
     >r over - r>
     [ / 1+ 0 max >integer ] keep
     range construct-boa ;
@@ -22,19 +22,19 @@ INSTANCE: range immutable-sequence
 
 : ,b) dup neg rot + swap ; inline
 
-: [a,b] twiddle <range> ;
+: [a,b] ( a b -- range ) twiddle <range> ;
 
-: (a,b] twiddle (a, <range> ;
+: (a,b] ( a b -- range ) twiddle (a, <range> ;
 
-: [a,b) twiddle ,b) <range> ;
+: [a,b) ( a b -- range ) twiddle ,b) <range> ;
 
-: (a,b) twiddle (a, ,b) <range> ;
+: (a,b) ( a b -- range ) twiddle (a, ,b) <range> ;
 
-: [0,b] 0 swap [a,b] ;
+: [0,b] ( b -- range ) 0 swap [a,b] ;
 
-: [1,b] 1 swap [a,b] ;
+: [1,b] ( b -- range ) 1 swap [a,b] ;
 
-: [0,b) 0 swap [a,b) ;
+: [0,b) ( b -- range ) 0 swap [a,b) ;
 
 : range-increasing? ( range -- ? )
     range-step 0 > ;

extra/tools/vocabs/vocabs.factor

@@ -34,8 +34,13 @@ IN: tools.vocabs
 
 : source-modified? ( path -- ? )
     dup source-files get at [
-        dup source-file-path ?resource-path utf8 file-lines lines-crc32
+        dup source-file-path ?resource-path
-        swap source-file-checksum = not
+        dup exists? [
+            utf8 file-lines lines-crc32
+            swap source-file-checksum = not
+        ] [
+            2drop f
+        ] if
     ] [
         resource-exists?
     ] ?if ;