From cc2f512287127d9f1f1e57178ab8699cf2e6d9e3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 3 Apr 2008 21:19:20 -0500 Subject: [PATCH] New classes.builtin vocab --- core/bootstrap/image/image.factor | 6 ++-- core/bootstrap/primitives.factor | 8 ++--- core/classes/algebra/algebra.factor | 8 ++--- core/classes/builtin/builtin-docs.factor | 28 +++++++++++++++ core/classes/builtin/builtin.factor | 18 ++++++++++ core/classes/classes-docs.factor | 27 +------------- core/classes/classes.factor | 13 ------- core/classes/singleton/singleton-docs.factor | 26 ++++++++------ core/classes/tuple/tuple.factor | 7 ++-- core/debugger/debugger.factor | 6 ++-- core/generic/generic-docs.factor | 10 +++++- core/generic/math/math.factor | 3 +- core/generic/standard/standard-docs.factor | 38 +++++++++++++++++++- core/layouts/layouts-docs.factor | 2 +- core/prettyprint/prettyprint.factor | 6 ++-- core/slots/slots-docs.factor | 4 +-- core/syntax/syntax-docs.factor | 17 ++++++++- extra/help/handbook/handbook.factor | 3 +- 18 files changed, 153 insertions(+), 77 deletions(-) create mode 100644 core/classes/builtin/builtin-docs.factor create mode 100644 core/classes/builtin/builtin.factor diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 6e0f8e2970..05d48af2e8 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -4,9 +4,9 @@ USING: alien arrays bit-arrays byte-arrays generic assocs hashtables assocs hashtables.private io kernel kernel.private math namespaces parser prettyprint sequences sequences.private strings sbufs vectors words quotations assocs system layouts -splitting growable classes classes.tuple classes.tuple.private -words.private io.binary io.files vocabs vocabs.loader -source-files definitions debugger float-arrays +splitting growable classes classes.builtin classes.tuple +classes.tuple.private words.private io.binary io.files vocabs +vocabs.loader source-files definitions debugger float-arrays quotations.private sequences.private combinators io.encodings.binary ; IN: bootstrap.image diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 6c87730278..516ff7ed74 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -3,10 +3,10 @@ USING: alien arrays byte-arrays generic hashtables hashtables.private io kernel math namespaces parser sequences strings vectors words quotations assocs layouts classes -classes.tuple classes.tuple.private kernel.private vocabs -vocabs.loader source-files definitions slots.deprecated -classes.union compiler.units bootstrap.image.private io.files -accessors combinators ; +classes.builtin classes.tuple classes.tuple.private +kernel.private vocabs vocabs.loader source-files definitions +slots.deprecated classes.union compiler.units +bootstrap.image.private io.files accessors combinators ; IN: bootstrap.primitives "Creating primitives and basic runtime structures..." print flush diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 97309dbea2..4614e4c4ce 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel classes combinators accessors sequences arrays -vectors assocs namespaces words sorting layouts math hashtables -kernel.private ; +USING: kernel classes classes.builtin combinators accessors +sequences arrays vectors assocs namespaces words sorting layouts +math hashtables kernel.private ; IN: classes.algebra : 2cache ( key1 key2 assoc quot -- value ) @@ -103,7 +103,7 @@ C: anonymous-complement { { [ over tuple eq? ] [ 2drop t ] } { [ over builtin-class? ] [ 2drop f ] } - { [ over tuple-class? ] [ [ class< ] 2keep swap class< or ] } + { [ over tuple-class? ] [ [ class< ] [ swap class< ] 2bi or ] } { [ t ] [ swap classes-intersect? ] } } cond ; diff --git a/core/classes/builtin/builtin-docs.factor b/core/classes/builtin/builtin-docs.factor new file mode 100644 index 0000000000..6c5c262087 --- /dev/null +++ b/core/classes/builtin/builtin-docs.factor @@ -0,0 +1,28 @@ +USING: help.syntax help.markup classes layouts ; +IN: classes.builtin + +ARTICLE: "builtin-classes" "Built-in classes" +"Every object is an instance of exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior." +$nl +"The set of built-in classes is a class:" +{ $subsection builtin-class } +{ $subsection builtin-class? } +"See " { $link "type-index" } " for a list of built-in classes." ; + +HELP: builtin-class +{ $class-description "The class of built-in classes." } +{ $examples + "The class of arrays is a built-in class:" + { $example "USING: arrays classes prettyprint ;" "array builtin-class? ." "t" } + "However, an instance of the array class is not a built-in class; it is not even a class:" + { $example "USING: classes prettyprint ;" "{ 1 2 3 } builtin-class? ." "f" } +} ; + +HELP: builtins +{ $var-description "Vector mapping type numbers to builtin class words." } ; + +HELP: type>class +{ $values { "n" "a non-negative integer" } { "class" class } } +{ $description "Outputs a builtin class whose instances are precisely those having a given pointer tag." } +{ $notes "The parameter " { $snippet "n" } " must be between 0 and the return value of " { $link num-types } "." } ; + diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor new file mode 100644 index 0000000000..1c2871b031 --- /dev/null +++ b/core/classes/builtin/builtin.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2004, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: classes words kernel kernel.private namespaces +sequences ; +IN: classes.builtin + +SYMBOL: builtins + +PREDICATE: builtin-class < class + "metaclass" word-prop builtin-class eq? ; + +: type>class ( n -- class ) builtins get-global nth ; + +: bootstrap-type>class ( n -- class ) builtins get nth ; + +M: hi-tag class hi-tag type>class ; + +M: object class tag type>class ; diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor index 3eaf7243c9..dd3782e877 100755 --- a/core/classes/classes-docs.factor +++ b/core/classes/classes-docs.factor @@ -4,14 +4,6 @@ layouts classes.private classes.union classes.mixin classes.predicate quotations ; IN: classes -ARTICLE: "builtin-classes" "Built-in classes" -"Every object is an instance of exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior." -$nl -"The set of built-in classes is a class:" -{ $subsection builtin-class } -{ $subsection builtin-class? } -"See " { $link "type-index" } " for a list of built-in classes." ; - ARTICLE: "class-predicates" "Class predicate words" "With a handful of exceptions, each class has a membership predicate word, named " { $snippet { $emphasis "class" } "?" } " . A quotation calling this predicate is stored in the " { $snippet "\"predicate\"" } " word property." $nl @@ -62,37 +54,20 @@ ABOUT: "classes" HELP: class { $values { "object" object } { "class" class } } { $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either its built-in class, or if the object is a tuple, its tuple class." } -{ $class-description "The class of all class words. Subclasses include " { $link builtin-class } ", " { $link union-class } ", " { $link mixin-class } ", " { $link predicate-class } " and " { $link tuple-class } "." } +{ $class-description "The class of all class words." } { $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ; HELP: classes { $values { "seq" "a sequence of class words" } } { $description "Finds all class words in the dictionary." } ; -HELP: builtin-class -{ $class-description "The class of built-in classes." } -{ $examples - "The class of arrays is a built-in class:" - { $example "USING: arrays classes prettyprint ;" "array builtin-class? ." "t" } - "However, an instance of the array class is not a built-in class; it is not even a class:" - { $example "USING: classes prettyprint ;" "{ 1 2 3 } builtin-class? ." "f" } -} ; - HELP: tuple-class { $class-description "The class of tuple class words." } { $examples { $example "USING: classes prettyprint ;" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ; -HELP: builtins -{ $var-description "Vector mapping type numbers to builtin class words." } ; - HELP: update-map { $var-description "Hashtable mapping each class to a set of classes defined in terms of this class. The " { $link define-class } " word uses this information to update generic words when classes are redefined." } ; -HELP: type>class -{ $values { "n" "a non-negative integer" } { "class" class } } -{ $description "Outputs a builtin class whose instances are precisely those having a given pointer tag." } -{ $notes "The parameter " { $snippet "n" } " must be between 0 and the return value of " { $link num-types } "." } ; - HELP: predicate-word { $values { "word" "a word" } { "predicate" "a predicate word" } } { $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index c45fd7360b..b22e21eb92 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -30,20 +30,11 @@ SYMBOL: update-map PREDICATE: class < word "class" word-prop ; -SYMBOL: builtins - -PREDICATE: builtin-class < class - "metaclass" word-prop builtin-class eq? ; - PREDICATE: tuple-class < class "metaclass" word-prop tuple-class eq? ; : classes ( -- seq ) all-words [ class? ] subset ; -: type>class ( n -- class ) builtins get-global nth ; - -: bootstrap-type>class ( n -- class ) builtins get nth ; - : predicate-word ( word -- predicate ) [ word-name "?" append ] keep word-vocabulary create ; @@ -130,9 +121,5 @@ GENERIC: update-methods ( assoc -- ) GENERIC: class ( object -- class ) -M: hi-tag class hi-tag type>class ; - -M: object class tag type>class ; - : instance? ( obj class -- ? ) "predicate" word-prop call ; diff --git a/core/classes/singleton/singleton-docs.factor b/core/classes/singleton/singleton-docs.factor index 8548f84a3a..a8dae809ec 100644 --- a/core/classes/singleton/singleton-docs.factor +++ b/core/classes/singleton/singleton-docs.factor @@ -2,27 +2,33 @@ USING: help.markup help.syntax kernel words ; IN: classes.singleton ARTICLE: "singletons" "Singleton classes" -"A singleton is a class with only one instance and with no state. Methods may dispatch off of singleton classes." +"A singleton is a class with only one instance and with no state." { $subsection POSTPONE: SINGLETON: } -{ $subsection define-singleton-class } ; +{ $subsection define-singleton-class } +"The set of all singleton classes is itself a class:" +{ $subsection singleton-class? } +{ $subsection singleton-class } ; HELP: SINGLETON: -{ $syntax "SINGLETON: class" -} { $values +{ $syntax "SINGLETON: class" } +{ $values { "class" "a new singleton to define" } -} { $description - "Defines a new predicate class whose superclass is " { $link word } ". Only one instance of a singleton may exist because classes are " { $link eq? } " to themselves. Methods may be defined on a singleton." -} { $examples +} +{ $description + "Defines a new singleton class. The class word itself is the sole instance of the singleton class." +} +{ $examples { $example "USING: classes.singleton kernel io ;" "SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" } -} { $see-also - POSTPONE: PREDICATE: } ; HELP: define-singleton-class { $values { "word" "a new word" } } { $description - "Defines a newly created word to be a singleton class." } ; + "Defines a singleton class. This is the run-time equivalent of " { $link POSTPONE: SINGLETON: } "." } ; { POSTPONE: SINGLETON: define-singleton-class } related-words +HELP: singleton-class +{ $class-description "The class of singleton classes." } ; + ABOUT: "singletons" diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 00178fd73e..ef81a0c953 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -56,7 +56,8 @@ PRIVATE> unclip slots>tuple ; : slot-names ( class -- seq ) - "slot-names" word-prop ; + "slot-names" word-prop + [ dup array? [ second ] when ] map ; over superclass-size 2 + simple-slots ; : define-tuple-slots ( class -- ) - dup dup slot-names generate-tuple-slots + dup dup "slot-names" word-prop generate-tuple-slots [ "slots" set-word-prop ] [ define-accessors ] ! new [ define-slots ] ! old @@ -162,7 +163,7 @@ M: tuple-class update-class : define-new-tuple-class ( class superclass slots -- ) [ drop f tuple-class define-class ] - [ nip [ dup array? [ second ] when ] map "slot-names" set-word-prop ] + [ nip "slot-names" set-word-prop ] [ 2drop update-classes ] 3tri ; diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index 033ae0680c..77e8f0ac05 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -4,9 +4,9 @@ USING: arrays definitions generic hashtables inspector io kernel math namespaces prettyprint sequences assocs sequences.private strings io.styles vectors words system splitting math.parser classes.tuple continuations continuations.private combinators -generic.math io.streams.duplex classes compiler.units -generic.standard vocabs threads threads.private init -kernel.private libc io.encodings ; +generic.math io.streams.duplex classes.builtin classes +compiler.units generic.standard vocabs threads threads.private +init kernel.private libc io.encodings ; IN: debugger GENERIC: error. ( error -- ) diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor index 2034bcf76b..1024c377a8 100755 --- a/core/generic/generic-docs.factor +++ b/core/generic/generic-docs.factor @@ -74,7 +74,10 @@ $nl "A lower-level word which the above expands into:" { $subsection (call-next-method) } "To look up the next applicable method reflectively:" -{ $subsection next-method } ; +{ $subsection next-method } +"Errors thrown by improper calls to " { $link POSTPONE: call-next-method } ":" +{ $subsection inconsistent-next-method } +{ $subsection no-next-method } ; ARTICLE: "generic" "Generic words and methods" "A " { $emphasis "generic word" } " is composed of zero or more " { $emphasis "methods" } " together with a " { $emphasis "method combination" } ". A method " { $emphasis "specializes" } " on a class; when a generic word executed, the method combination chooses the most appropriate method and calls its definition." @@ -160,3 +163,8 @@ HELP: forget-methods { $description "Remove all method definitions which specialize on the class." } ; { sort-classes order } related-words + +HELP: (call-next-method) +{ $values { "class" class } { "generic" generic } } +{ $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." } +{ $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ; diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 46208744f0..fce908bdef 100755 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays generic hashtables kernel kernel.private math namespaces sequences words quotations layouts combinators -sequences.private classes classes.algebra definitions ; +sequences.private classes classes.builtin classes.algebra +definitions ; IN: generic.math PREDICATE: math-class < class diff --git a/core/generic/standard/standard-docs.factor b/core/generic/standard/standard-docs.factor index a6a65bb62f..09746d35f5 100644 --- a/core/generic/standard/standard-docs.factor +++ b/core/generic/standard/standard-docs.factor @@ -1,4 +1,5 @@ -USING: generic help.markup help.syntax sequences ; +USING: generic help.markup help.syntax sequences math +math.parser ; IN: generic.standard HELP: no-method @@ -31,3 +32,38 @@ HELP: define-simple-generic { $description "Defines a generic word with the " { $link standard-combination } " method combination and a dispatch position of 0." } ; { standard-combination hook-combination } related-words + +HELP: no-next-method +{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the current method is already the least specific method." } +{ $examples + "The following code throws this error:" + { $code + "GENERIC: error-test ( object -- )" + "" + "M: number error-test 3 + call-next-method ;" + "" + "M: integer error-test recip call-next-method ;" + "" + "123 error-test" + } + "This results in the method on " { $link integer } " being called, which then calls the method on " { $link number } ". The latter then calls " { $link POSTPONE: call-next-method } ", however there is no method less specific than the method on " { $link number } " and so an error is thrown." +} ; + +HELP: inconsistent-next-method +{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the values on the stack are not compatible with the current method." } +{ $examples + "The following code throws this error:" + { $code + "GENERIC: error-test ( object -- )" + "" + "M: string error-test print ;" + "" + "M: integer error-test number>string call-next-method ;" + "" + "123 error-test" + } + "This results in the method on " { $link integer } " being called, which then passes a string to " { $link POSTPONE: call-next-method } ". However, this fails because the string is not compatible with the current method." + $nl + "This usually indicates programmer error; if the intention above was to call the string method on the result of " { $link number>string } ", the code should be rewritten as follows:" + { $code "M: integer error-test number>string error-test ;" } +} ; diff --git a/core/layouts/layouts-docs.factor b/core/layouts/layouts-docs.factor index 089465177b..a54df30c50 100755 --- a/core/layouts/layouts-docs.factor +++ b/core/layouts/layouts-docs.factor @@ -1,6 +1,6 @@ USING: generic help.markup help.syntax kernel math memory namespaces sequences kernel.private classes -sequences.private ; +classes.builtin sequences.private ; IN: layouts HELP: tag-bits diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index fd7133053a..03d3e456ca 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -5,9 +5,9 @@ USING: alien arrays generic generic.standard assocs io kernel math namespaces sequences strings io.styles io.streams.string vectors words prettyprint.backend prettyprint.sections prettyprint.config sorting splitting math.parser vocabs -definitions effects classes.tuple io.files classes continuations -hashtables classes.mixin classes.union classes.predicate -classes.singleton combinators quotations ; +definitions effects classes.builtin classes.tuple io.files +classes continuations hashtables classes.mixin classes.union +classes.predicate classes.singleton combinators quotations ; : make-pprint ( obj quot -- block in use ) [ diff --git a/core/slots/slots-docs.factor b/core/slots/slots-docs.factor index 2b0d721f3e..29facb31f2 100755 --- a/core/slots/slots-docs.factor +++ b/core/slots/slots-docs.factor @@ -1,7 +1,7 @@ USING: help.markup help.syntax generic kernel.private parser words kernel quotations namespaces sequences words arrays -effects generic.standard classes.tuple slots.private classes -strings math ; +effects generic.standard classes.tuple classes.builtin +slots.private classes strings math ; IN: slots ARTICLE: "accessors" "Slot accessors" diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index b242e65de5..39a4d266e9 100755 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -1,6 +1,7 @@ USING: generic help.syntax help.markup kernel math parser words effects classes generic.standard classes.tuple generic.math -arrays io.files vocabs.loader io sequences assocs ; +generic.standard arrays io.files vocabs.loader io sequences +assocs ; IN: syntax ARTICLE: "parser-algorithm" "Parser algorithm" @@ -633,4 +634,18 @@ HELP: >> { $syntax ">>" } { $description "Marks the end of a parse time code block." } ; +HELP: call-next-method +{ $description "Calls the next applicable method. Only valid inside a method definition. The values at the top of the stack are passed on to the next method, and they must be compatible with that method's class specializer." } +{ $notes "This is syntax sugar around " { $link (call-next-method) } ". The following two lines are equivalent:" + { $code + "M: my-class my-generic ... call-next-method ... ;" + "M: my-class my-generic ... \\ my-class \\ my-generic (call-next-method) ... ;" + } +"In most cases, this word should be called with the original input values on the stack. Calling it with other values is usually a sign of poor design." } +{ $errors + "Throws a " { $link no-next-method } " error if this is the least specific method, and throws an " { $link inconsistent-next-method } " error if the values at the top of the stack are not compatible with the current method's specializer." +} ; + +{ POSTPONE: call-next-method (call-next-method) next-method } related-words + { POSTPONE: << POSTPONE: >> } related-words diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 847a5952af..acdbca82ee 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -2,7 +2,8 @@ USING: help help.markup help.syntax help.definitions help.topics namespaces words sequences classes assocs vocabs kernel arrays prettyprint.backend kernel.private io generic math system strings sbufs vectors byte-arrays bit-arrays float-arrays -quotations io.streams.byte-array io.encodings.string ; +quotations io.streams.byte-array io.encodings.string +classes.builtin ; IN: help.handbook ARTICLE: "conventions" "Conventions"