diff --git a/core/alien/alien.factor b/core/alien/alien.factor index e48a3efd60..d76966c9c2 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -18,15 +18,18 @@ PREDICATE: pinned-alien < alien underlying>> pinned-c-ptr? ; UNION: pinned-c-ptr pinned-alien POSTPONE: f ; -GENERIC: expired? ( c-ptr -- ? ) +GENERIC: expired? ( c-ptr -- ? ) flushable -M: alien expired? expired?>> ; +M: alien expired? expired>> ; M: f expired? drop t ; : ( address -- alien ) f { simple-c-ptr } declare ; inline +: ( -- alien ) + -1 t >>expired ; inline + M: alien equal? over alien? [ 2dup [ expired? ] either? [ diff --git a/core/alien/syntax/syntax.factor b/core/alien/syntax/syntax.factor index a756734f7b..7629897fc0 100755 --- a/core/alien/syntax/syntax.factor +++ b/core/alien/syntax/syntax.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2005, 2008 Slava Pestov, Alex Chapman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays alien alien.c-types alien.structs alien.arrays -alien.strings kernel math namespaces parser sequences words -quotations math.parser splitting grouping effects prettyprint -prettyprint.sections prettyprint.backend assocs combinators -lexer strings.parser ; +USING: accessors arrays alien alien.c-types alien.structs +alien.arrays alien.strings kernel math namespaces parser +sequences words quotations math.parser splitting grouping +effects prettyprint prettyprint.sections prettyprint.backend +assocs combinators lexer strings.parser ; IN: alien.syntax : ALIEN: scan string>number parsed ; parsing +: BAD-ALIEN parsed ; parsing + : LIBRARY: scan "c-library" set ; parsing : FUNCTION: @@ -67,7 +69,7 @@ PRIVATE> M: alien pprint* { - { [ dup expired? ] [ drop "( alien expired )" text ] } + { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] } { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] } [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ] } cond ; diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index cb60d8768e..c982169761 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -247,14 +247,12 @@ bi "dll" "alien" create { { "path" { "byte-array" "byte-arrays" } read-only } -} -define-builtin +} define-builtin "alien" "alien" create { { "underlying" { "c-ptr" "alien" } read-only } - { "expired?" read-only } -} -define-builtin + "expired" +} define-builtin "word" "words" create { { "hashcode" { "fixnum" "math" } } diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 260730383b..411820ef4f 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -5,7 +5,9 @@ lexer combinators words classes.parser classes.tuple arrays ; IN: classes.tuple.parser : shadowed-slots ( superclass slots -- shadowed ) - >r all-slot-names r> intersect ; + [ all-slots [ name>> ] map ] + [ [ dup array? [ first ] when ] map ] + bi* intersect ; : check-slot-shadowing ( class superclass slots -- ) shadowed-slots [ diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index a90e7cc6da..c3ad6be1c2 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -529,9 +529,6 @@ set-primitive-effect \ fclose { alien } { } set-primitive-effect -\ expired? { object } { object } set-primitive-effect -\ expired? make-flushable - \ { object } { wrapper } set-primitive-effect \ make-foldable diff --git a/core/mirrors/mirrors-tests.factor b/core/mirrors/mirrors-tests.factor index a2e98f2fbb..879ec55861 100755 --- a/core/mirrors/mirrors-tests.factor +++ b/core/mirrors/mirrors-tests.factor @@ -6,6 +6,8 @@ TUPLE: foo bar baz ; C: foo +[ 3 ] [ 1 2 assoc-size ] 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 10638ead00..641fce6efc 100755 --- a/core/mirrors/mirrors.factor +++ b/core/mirrors/mirrors.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs hashtables kernel sequences generic words -arrays classes slots slots.private classes.tuple math vectors -quotations accessors combinators ; +arrays classes slots slots.private classes.tuple +classes.tuple.private math vectors quotations accessors +combinators ; IN: mirrors TUPLE: mirror { object read-only } ; @@ -40,7 +41,7 @@ M: mirror >alist ( mirror -- alist ) [ object>> [ swap slot ] curry ] bi map zip ; -M: mirror assoc-size mirror-slots length ; +M: mirror assoc-size object>> layout-of size>> ; INSTANCE: mirror assoc diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 9544e66088..cbda2d9b3a 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -3,7 +3,7 @@ USING: arrays bit-arrays byte-arrays float-arrays kernel kernel.private math namespaces sequences strings words effects generic generic.standard classes classes.algebra slots.private -combinators accessors words sequences.private assocs ; +combinators accessors words sequences.private assocs alien ; IN: slots TUPLE: slot-spec name offset class initial read-only reader writer ; @@ -135,6 +135,7 @@ ERROR: no-initial-value class ; { [ bit-array bootstrap-word over class<= ] [ ?{ } ] } { [ byte-array bootstrap-word over class<= ] [ B{ } ] } { [ float-array bootstrap-word over class<= ] [ F{ } ] } + { [ simple-alien bootstrap-word over class<= ] [ ] } [ no-initial-value ] } cond nip ; diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index 2683c314d8..f08082c4ee 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -8,7 +8,7 @@ IN: io.buffers TUPLE: buffer { size fixnum } -{ ptr simple-alien initial: ALIEN: -1 } +{ ptr simple-alien } { fill fixnum } { pos fixnum } disposed ;