diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 574002921a..c4db604784 100755 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -99,8 +99,8 @@ unit-test 3 H{ } clone 2 [ - 2dup [ , f ] cache + 2dup [ , f ] cache drop ] times 2drop - ] make + ] { } make ] unit-test diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor index 632af1d040..87c72048f4 100755 --- a/core/classes/algebra/algebra-docs.factor +++ b/core/classes/algebra/algebra-docs.factor @@ -30,7 +30,7 @@ HELP: class-types { $description "Outputs a sequence of builtin type numbers whose instances can possibly be instances of the given class." } ; HELP: class< -{ $values { "class1" "a class" } { "class2" "a class" } { "?" "a boolean" } } +{ $values { "first" "a class" } { "second" "a class" } { "?" "a boolean" } } { $description "Tests if all instances of " { $snippet "class1" } " are also instances of " { $snippet "class2" } "." } { $notes "Classes are partially ordered. This means that if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class1" } ", then " { $snippet "class1 = class2" } ". Also, if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class3" } ", then " { $snippet "class1 <= class3" } "." } ; diff --git a/core/compiler/tests/templates.factor b/core/compiler/tests/templates.factor index 1c19730ec0..8a33d57fe7 100755 --- a/core/compiler/tests/templates.factor +++ b/core/compiler/tests/templates.factor @@ -81,8 +81,8 @@ unit-test -12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-call ] unit-test -[ 2 ] [ - SBUF" " [ 2 slot 2 [ slot ] keep ] compile-call nip +[ 1 ] [ + SBUF" " [ 1 slot 1 [ slot ] keep ] compile-call nip ] unit-test ! Test slow shuffles diff --git a/core/mirrors/mirrors-tests.factor b/core/mirrors/mirrors-tests.factor index 8f2964b19d..11e5772000 100755 --- a/core/mirrors/mirrors-tests.factor +++ b/core/mirrors/mirrors-tests.factor @@ -5,7 +5,7 @@ TUPLE: foo bar baz ; C: foo -[ { "bar" "baz" } ] [ 1 2 keys ] unit-test +[ { "delegate" "bar" "baz" } ] [ 1 2 keys ] unit-test [ 1 t ] [ "bar" 1 2 at* ] unit-test diff --git a/core/mirrors/mirrors.factor b/core/mirrors/mirrors.factor index 7176076c7c..3c5a0aa3c7 100755 --- a/core/mirrors/mirrors.factor +++ b/core/mirrors/mirrors.factor @@ -5,13 +5,11 @@ arrays classes slots slots.private tuples math vectors quotations sorting prettyprint ; IN: mirrors -GENERIC: object-slots ( obj -- seq ) +: all-slots ( class -- slots ) + superclasses [ "slots" word-prop ] map concat ; -M: object object-slots class "slots" word-prop ; - -M: tuple object-slots - dup class superclasses [ "slots" word-prop ] map concat - swap delegate [ 1 tail-slice ] unless ; +: object-slots ( obj -- seq ) + class all-slots ; TUPLE: mirror object slots ; diff --git a/core/tuples/tuples-docs.factor b/core/tuples/tuples-docs.factor index 6e0f319c9a..55e15d6dc6 100755 --- a/core/tuples/tuples-docs.factor +++ b/core/tuples/tuples-docs.factor @@ -191,7 +191,7 @@ HELP: define-tuple-predicate $low-level-note ; HELP: redefine-tuple-class -{ $values { "class" class } { "superclass" class } { "newslots" "a sequence of strings" } } +{ $values { "class" class } { "superclass" class } { "slots" "a sequence of strings" } } { $description "If the new slot layout differs from the existing one, updates all existing instances of this tuple class, and forgets any slot accessor words which are no longer needed." $nl "If the class is not a tuple class word, this word does nothing." } diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 09dd03de2f..89aff6f185 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -36,7 +36,7 @@ PRIVATE> [ layout-size swap [ array-nth ] curry map ] keep layout-class add* ; -: >tuple ( sequence -- tuple ) +: >tuple ( seq -- tuple ) dup first tuple-layout [ >r 1 tail-slice dup length r> [ tuple-size min ] keep diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 1468065ebe..308bf36bf4 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -1,7 +1,7 @@ USING: kernel words inspector slots quotations sequences assocs math arrays inference effects shuffle continuations debugger tuples namespaces vectors bit-arrays byte-arrays strings sbufs -math.functions macros sequences.private combinators ; +math.functions macros sequences.private combinators mirrors ; IN: inverse TUPLE: fail ; @@ -191,7 +191,7 @@ MACRO: undo ( quot -- ) [undo] ; "predicate" word-prop [ dupd call assure ] curry ; : slot-readers ( class -- quot ) - "slots" word-prop 1 tail ! tail gets rid of delegate + all-slots 1 tail ! tail gets rid of delegate [ slot-spec-reader 1quotation [ keep ] curry ] map concat [ ] like [ drop ] compose ; diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor index 2f0ba6bde5..f06bb55899 100755 --- a/extra/tuple-syntax/tuple-syntax.factor +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -1,5 +1,5 @@ USING: kernel sequences slots parser words classes -slots.private ; +slots.private mirrors ; IN: tuple-syntax ! TUPLE: foo bar baz ; @@ -10,8 +10,7 @@ IN: tuple-syntax : parse-slot-writer ( tuple -- slot# ) scan dup "}" = [ 2drop f ] [ - 1 head* swap class "slots" word-prop - [ slot-spec-name = ] with find nip slot-spec-offset + 1 head* swap object-slots slot-named slot-spec-offset ] if ; : parse-slots ( accum tuple -- accum tuple ) diff --git a/extra/tuples/lib/lib.factor b/extra/tuples/lib/lib.factor old mode 100644 new mode 100755 index 5075c1d94a..4c007c8bb1 --- a/extra/tuples/lib/lib.factor +++ b/extra/tuples/lib/lib.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel macros sequences slots words ; +USING: kernel macros sequences slots words mirrors ; IN: tuples.lib : reader-slots ( seq -- quot ) [ slot-spec-reader ] map [ get-slots ] curry ; MACRO: >tuple< ( class -- ) - "slots" word-prop 1 tail-slice reader-slots ; + all-slots 1 tail-slice reader-slots ; MACRO: >tuple*< ( class -- ) - "slots" word-prop + all-slots [ slot-spec-name "*" tail? ] subset reader-slots ;