diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor new file mode 100644 index 0000000000..5273c2c7ba --- /dev/null +++ b/basis/alien/structs/fields/fields.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2005, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays kernel kernel.private math namespaces +sequences strings words effects combinators alien.c-types ; +IN: alien.structs.fields + +TUPLE: field-spec name offset type reader writer ; + +: reader-effect ( type spec -- effect ) + [ 1array ] [ name>> 1array ] bi* ; + +PREDICATE: slot-reader < word "reading" word-prop >boolean ; + +: set-reader-props ( class spec -- ) + 2dup reader-effect + over reader>> + swap "declared-effect" set-word-prop + reader>> swap "reading" set-word-prop ; + +: writer-effect ( type spec -- effect ) + name>> swap 2array 0 ; + +PREDICATE: slot-writer < word "writing" word-prop >boolean ; + +: set-writer-props ( class spec -- ) + 2dup writer-effect + over writer>> + swap "declared-effect" set-word-prop + writer>> swap "writing" set-word-prop ; + +: reader-word ( class name vocab -- word ) + >r >r "-" r> 3append r> create ; + +: writer-word ( class name vocab -- word ) + >r [ swap "set-" % % "-" % % ] "" make r> create ; + +: ( struct-name vocab type field-name -- spec ) + field-spec new + 0 >>offset + swap >>name + swap expand-constants >>type + 3dup name>> swap reader-word >>reader + 3dup name>> swap writer-word >>writer + 2nip ; + +: align-offset ( offset type -- offset ) + c-type-align align ; + +: struct-offsets ( specs -- size ) + 0 [ + [ type>> align-offset ] keep + [ (>>offset) ] [ type>> heap-size + ] 2bi + ] reduce ; + +: define-struct-slot-word ( spec word quot -- ) + rot offset>> prefix define-inline ; + +: define-getter ( type spec -- ) + [ set-reader-props ] keep + [ ] + [ reader>> ] + [ + type>> + [ c-getter ] [ c-type-boxer-quot ] bi append + ] tri + define-struct-slot-word ; + +: define-setter ( type spec -- ) + [ set-writer-props ] keep + [ ] + [ writer>> ] + [ type>> c-setter ] tri + define-struct-slot-word ; + +: define-field ( type spec -- ) + [ define-getter ] [ define-setter ] 2bi ; diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor index 6f83885d9f..62b8510d17 100755 --- a/basis/alien/structs/structs-docs.factor +++ b/basis/alien/structs/structs-docs.factor @@ -1,75 +1,7 @@ -IN: alien.structs USING: accessors alien.c-types strings help.markup help.syntax -alien.syntax sequences io arrays slots.deprecated -kernel words slots assocs namespaces accessors ; - -! Deprecated code -: ($spec-reader-values) ( slot-spec class -- element ) - dup ?word-name swap 2array - over name>> - rot class>> 2array 2array - [ { $instance } swap suffix ] assoc-map ; - -: $spec-reader-values ( slot-spec class -- ) - ($spec-reader-values) $values ; - -: $spec-reader-description ( slot-spec class -- ) - [ - "Outputs the value stored in the " , - { $snippet } rot name>> suffix , - " slot of " , - { $instance } swap suffix , - " instance." , - ] { } make $description ; - -: slot-of-reader ( reader specs -- spec/f ) - [ reader>> eq? ] with find nip ; - -: $spec-reader ( reader slot-specs class -- ) - >r slot-of-reader r> - over [ - 2dup $spec-reader-values - 2dup $spec-reader-description - ] when 2drop ; - -GENERIC: slot-specs ( help-type -- specs ) - -M: word slot-specs "slots" word-prop ; - -: $slot-reader ( reader -- ) - first dup "reading" word-prop [ slot-specs ] keep - $spec-reader ; - -: $spec-writer-values ( slot-spec class -- ) - ($spec-reader-values) reverse $values ; - -: $spec-writer-description ( slot-spec class -- ) - [ - "Stores a new value to the " , - { $snippet } rot name>> suffix , - " slot of " , - { $instance } swap suffix , - " instance." , - ] { } make $description ; - -: slot-of-writer ( writer specs -- spec/f ) - [ writer>> eq? ] with find nip ; - -: $spec-writer ( writer slot-specs class -- ) - >r slot-of-writer r> - over [ - 2dup $spec-writer-values - 2dup $spec-writer-description - dup ?word-name 1array $side-effects - ] when 2drop ; - -: $slot-writer ( reader -- ) - first dup "writing" word-prop [ slot-specs ] keep - $spec-writer ; - -M: string slot-specs c-type fields>> ; - -M: array ($instance) first ($instance) " array" write ; +alien.syntax sequences io arrays kernel words assocs namespaces +accessors ; +IN: alien.structs ARTICLE: "c-structs" "C structure types" "A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset from the start of the block. The C library interface provides some utilities to define words which read and write structure fields given a base address." diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index e6a363941d..e82d663d08 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -1,43 +1,10 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays generic hashtables kernel kernel.private -math namespaces parser sequences strings words libc slots -slots.deprecated alien.c-types cpu.architecture ; +math namespaces parser sequences strings words libc +alien.c-types alien.structs.fields cpu.architecture ; IN: alien.structs -: align-offset ( offset type -- offset ) - c-type-align align ; - -: struct-offsets ( specs -- size ) - 0 [ - [ class>> align-offset ] keep - [ (>>offset) ] 2keep - class>> heap-size + - ] reduce ; - -: define-struct-slot-word ( spec word quot -- ) - rot offset>> prefix define-inline ; - -: define-getter ( type spec -- ) - [ set-reader-props ] keep - [ ] - [ reader>> ] - [ - class>> - [ c-getter ] [ c-type-boxer-quot ] bi append - ] tri - define-struct-slot-word ; - -: define-setter ( type spec -- ) - [ set-writer-props ] keep - [ ] - [ writer>> ] - [ class>> c-setter ] tri - define-struct-slot-word ; - -: define-field ( type spec -- ) - 2dup define-getter define-setter ; - : if-value-structs? ( ctype true false -- ) value-structs? [ drop call ] [ >r 2drop "void*" r> call ] if ; inline @@ -76,17 +43,8 @@ M: struct-type stack-size struct-type boa -rot define-c-type ; -: make-field ( struct-name vocab type field-name -- spec ) - - 0 >>offset - swap >>name - swap expand-constants >>class - 3dup name>> swap reader-word >>reader - 3dup name>> swap writer-word >>writer - 2nip ; - : define-struct-early ( name vocab fields -- fields ) - -rot [ rot first2 make-field ] 2curry map ; + -rot [ rot first2 ] 2curry map ; : compute-struct-align ( types -- n ) [ c-type-align ] map supremum ; @@ -94,7 +52,7 @@ M: struct-type stack-size : define-struct ( name vocab fields -- ) pick >r [ struct-offsets ] keep - [ [ class>> ] map compute-struct-align ] keep + [ [ type>> ] map compute-struct-align ] keep [ (define-struct) ] keep r> [ swap define-field ] curry each ; diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index d340c21663..2dd6e440d5 100755 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -43,8 +43,8 @@ SYMBOL: +failed+ [ dup crossref? [ - dependencies get - generic-dependencies get + dependencies get >alist + generic-dependencies get >alist compiled-xref ] [ drop ] if ] tri ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index c1697f1d98..6e864ab968 100755 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -178,7 +178,7 @@ stack-params "__stack_value" c-type (>>reg-class) >> : struct-types&offset ( struct-type -- pairs ) fields>> [ - [ class>> ] [ offset>> ] bi 2array + [ type>> ] [ offset>> ] bi 2array ] map ; : split-struct ( pairs -- seq ) diff --git a/extra/csv/authors.txt b/basis/csv/authors.txt similarity index 100% rename from extra/csv/authors.txt rename to basis/csv/authors.txt diff --git a/extra/csv/csv-docs.factor b/basis/csv/csv-docs.factor similarity index 100% rename from extra/csv/csv-docs.factor rename to basis/csv/csv-docs.factor diff --git a/extra/csv/csv-tests.factor b/basis/csv/csv-tests.factor similarity index 100% rename from extra/csv/csv-tests.factor rename to basis/csv/csv-tests.factor diff --git a/extra/csv/csv.factor b/basis/csv/csv.factor similarity index 100% rename from extra/csv/csv.factor rename to basis/csv/csv.factor diff --git a/extra/csv/summary.txt b/basis/csv/summary.txt similarity index 100% rename from extra/csv/summary.txt rename to basis/csv/summary.txt diff --git a/basis/debugger/threads/threads.factor b/basis/debugger/threads/threads.factor index 093d231d08..7bb240859e 100644 --- a/basis/debugger/threads/threads.factor +++ b/basis/debugger/threads/threads.factor @@ -10,14 +10,17 @@ IN: debugger.threads dup id>> # " (" % dup name>> % ", " % dup quot>> unparse-short % ")" % - ] "" make swap write-object ":" print nl ; + ] "" make swap write-object ":" print ; M: thread error-in-thread ( error thread -- ) initial-thread get-global eq? [ die drop ] [ global [ - error-thread get-global error-in-thread. print-error flush + error-thread get-global error-in-thread. nl + print-error nl + :c + flush ] bind ] if ; diff --git a/basis/stack-checker/state/state.factor b/basis/stack-checker/state/state.factor index 3d3db980e1..0d0de7f19b 100755 --- a/basis/stack-checker/state/state.factor +++ b/basis/stack-checker/state/state.factor @@ -89,8 +89,11 @@ SYMBOL: meta-r SYMBOL: dependencies : depends-on ( word how -- ) - dependencies get dup - [ swap '[ , strongest-dependency ] change-at ] [ 3drop ] if ; + over primitive? [ 2drop ] [ + dependencies get dup [ + swap '[ , strongest-dependency ] change-at + ] [ 3drop ] if + ] if ; ! Generic words that the current quotation depends on SYMBOL: generic-dependencies diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 56e995899b..d569103d97 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -62,10 +62,13 @@ TUPLE: check-mixin-class mixin ; ] if-mixin-member? ; : remove-mixin-instance ( class mixin -- ) + #! The order of the three clauses is important here. The last + #! one must come after the other two so that the entries it + #! adds to changed-generics are not overwritten. [ - [ class-usages update-methods ] [ [ swap remove ] change-mixin-class ] [ nip update-classes ] + [ class-usages update-methods ] 2tri ] [ 2drop ] if-mixin-member? ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index fa29a5a519..cb361ec9e6 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -110,8 +110,7 @@ SYMBOL: update-tuples-hook : (compiled-generic-usages) ( generic class -- assoc ) dup class? [ [ compiled-generic-usage ] dip - [ [ classes-intersect? ] [ null class<= ] bi or nip ] - curry assoc-filter + [ classes-intersect? nip ] curry assoc-filter ] [ 2drop f ] if ; : compiled-generic-usages ( assoc -- assocs ) diff --git a/core/slots/deprecated/deprecated.factor b/core/slots/deprecated/deprecated.factor deleted file mode 100755 index df16f0baa8..0000000000 --- a/core/slots/deprecated/deprecated.factor +++ /dev/null @@ -1,81 +0,0 @@ -! Copyright (C) 2005, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel kernel.private math namespaces -sequences strings words effects generic generic.standard -classes slots.private combinators slots ; -IN: slots.deprecated - -: reader-effect ( class spec -- effect ) - >r ?word-name 1array r> name>> 1array ; - -PREDICATE: slot-reader < word "reading" word-prop >boolean ; - -: set-reader-props ( class spec -- ) - 2dup reader-effect - over reader>> - swap "declared-effect" set-word-prop - reader>> swap "reading" set-word-prop ; - -: define-slot-word ( class word quot -- ) - [ - dup define-simple-generic - create-method - ] dip define ; - -: define-reader ( class spec -- ) - dup reader>> [ - [ set-reader-props ] 2keep - dup reader>> - swap reader-quot - define-slot-word - ] [ - 2drop - ] if ; - -: writer-effect ( class spec -- effect ) - name>> swap ?word-name 2array 0 ; - -PREDICATE: slot-writer < word "writing" word-prop >boolean ; - -: set-writer-props ( class spec -- ) - 2dup writer-effect - over writer>> - swap "declared-effect" set-word-prop - writer>> swap "writing" set-word-prop ; - -: define-writer ( class spec -- ) - dup writer>> [ - [ set-writer-props ] 2keep - dup writer>> - swap writer-quot - define-slot-word - ] [ - 2drop - ] if ; - -: define-slot ( class spec -- ) - 2dup define-reader define-writer ; - -: define-slots ( class specs -- ) - [ define-slot ] with each ; - -: reader-word ( class name vocab -- word ) - >r >r "-" r> 3append r> create ; - -: writer-word ( class name vocab -- word ) - >r [ swap "set-" % % "-" % % ] "" make r> create ; - -: (simple-slot-word) ( class name -- class name vocab ) - over vocabulary>> >r >r name>> r> r> ; - -: simple-reader-word ( class name -- word ) - (simple-slot-word) reader-word ; - -: simple-writer-word ( class name -- word ) - (simple-slot-word) writer-word ; - -: deprecated-slots ( class slot-specs -- slot-specs' ) - [ - 2dup name>> simple-reader-word >>reader - 2dup name>> simple-writer-word >>writer - ] map nip ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 8754444ce0..6f831c30c5 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -6,7 +6,7 @@ classes.algebra slots.private combinators accessors words sequences.private assocs alien ; IN: slots -TUPLE: slot-spec name offset class initial read-only reader writer ; +TUPLE: slot-spec name offset class initial read-only ; PREDICATE: reader < word "reader" word-prop ; diff --git a/extra/benchmark/euler150/euler150.factor b/extra/benchmark/euler150/euler150.factor index 5ee7c57e17..448c8575f9 100644 --- a/extra/benchmark/euler150/euler150.factor +++ b/extra/benchmark/euler150/euler150.factor @@ -1,4 +1,7 @@ IN: benchmark.euler150 -USE: project-euler.150 +USING: kernel project-euler.150 ; -MAIN: euler150 +: euler150-benchmark ( -- ) + euler150 -271248680 assert= ; + +MAIN: euler150-benchmark diff --git a/extra/benchmark/euler186/euler186.factor b/extra/benchmark/euler186/euler186.factor index 1124c8807c..681ca0e269 100644 --- a/extra/benchmark/euler186/euler186.factor +++ b/extra/benchmark/euler186/euler186.factor @@ -1,4 +1,7 @@ IN: benchmark.euler186 -USE: project-euler.186 +USING: kernel project-euler.186 ; -MAIN: euler186 +: euler186-benchmark ( -- ) + euler186 2325629 assert= ; + +MAIN: euler186-benchmark diff --git a/extra/benchmark/typecheck4/typecheck4.factor b/extra/benchmark/typecheck4/typecheck4.factor index a2595810be..c881864304 100644 --- a/extra/benchmark/typecheck4/typecheck4.factor +++ b/extra/benchmark/typecheck4/typecheck4.factor @@ -3,7 +3,7 @@ IN: benchmark.typecheck4 TUPLE: hello n ; -: hello-n* ( obj -- val ) 3 slot ; +: hello-n* ( obj -- val ) 2 slot ; : foo ( obj -- obj n ) 0 100000000 [ over hello-n* + ] times ; diff --git a/extra/math/blas/cblas/tags.txt b/extra/math/blas/cblas/tags.txt index 241ec1ecda..5118958180 100644 --- a/extra/math/blas/cblas/tags.txt +++ b/extra/math/blas/cblas/tags.txt @@ -1,2 +1,3 @@ math bindings +unportable diff --git a/extra/math/blas/matrices/tags.txt b/extra/math/blas/matrices/tags.txt index 241ec1ecda..5118958180 100644 --- a/extra/math/blas/matrices/tags.txt +++ b/extra/math/blas/matrices/tags.txt @@ -1,2 +1,3 @@ math bindings +unportable diff --git a/extra/math/blas/syntax/tags.txt b/extra/math/blas/syntax/tags.txt index ede10ab61b..6a932d96d2 100644 --- a/extra/math/blas/syntax/tags.txt +++ b/extra/math/blas/syntax/tags.txt @@ -1 +1,2 @@ math +unportable diff --git a/extra/math/blas/vectors/tags.txt b/extra/math/blas/vectors/tags.txt index ede10ab61b..6a932d96d2 100644 --- a/extra/math/blas/vectors/tags.txt +++ b/extra/math/blas/vectors/tags.txt @@ -1 +1,2 @@ math +unportable