From 02a2752fa5c5558ca5b5240956781214259656b0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 03:45:34 -0600 Subject: [PATCH 1/8] Add 'class' slot to c-types --- basis/alien/c-types/c-types.factor | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 543af8dee8..46d63c3375 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -13,13 +13,15 @@ DEFER: *char : little-endian? ( -- ? ) 1 *char 1 = ; foldable TUPLE: c-type +class boxer boxer-quot unboxer unboxer-quot getter setter reg-class size align stack-align? ; : new-c-type ( class -- type ) new - int-regs >>reg-class ; + int-regs >>reg-class + object >>class ; : ( -- type ) \ c-type new-c-type ; @@ -63,6 +65,12 @@ M: string c-type ( name -- type ) ] ?if ] if ; +GENERIC: c-type-class ( name -- class ) + +M: c-type c-type-class class>> ; + +M: string c-type-class c-type c-type-class ; + GENERIC: c-type-boxer ( name -- boxer ) M: c-type c-type-boxer boxer>> ; @@ -306,6 +314,7 @@ M: long-long-type box-return ( type -- ) [ + c-ptr >>class [ alien-cell ] >>getter [ set-alien-cell ] >>setter bootstrap-cell >>size @@ -315,6 +324,7 @@ M: long-long-type box-return ( type -- ) "void*" define-primitive-type + integer >>class [ alien-signed-8 ] >>getter [ set-alien-signed-8 ] >>setter 8 >>size @@ -324,6 +334,7 @@ M: long-long-type box-return ( type -- ) "longlong" define-primitive-type + integer >>class [ alien-unsigned-8 ] >>getter [ set-alien-unsigned-8 ] >>setter 8 >>size @@ -333,6 +344,7 @@ M: long-long-type box-return ( type -- ) "ulonglong" define-primitive-type + integer >>class [ alien-signed-cell ] >>getter [ set-alien-signed-cell ] >>setter bootstrap-cell >>size @@ -342,6 +354,7 @@ M: long-long-type box-return ( type -- ) "long" define-primitive-type + integer >>class [ alien-unsigned-cell ] >>getter [ set-alien-unsigned-cell ] >>setter bootstrap-cell >>size @@ -351,6 +364,7 @@ M: long-long-type box-return ( type -- ) "ulong" define-primitive-type + integer >>class [ alien-signed-4 ] >>getter [ set-alien-signed-4 ] >>setter 4 >>size @@ -360,6 +374,7 @@ M: long-long-type box-return ( type -- ) "int" define-primitive-type + integer >>class [ alien-unsigned-4 ] >>getter [ set-alien-unsigned-4 ] >>setter 4 >>size @@ -369,6 +384,7 @@ M: long-long-type box-return ( type -- ) "uint" define-primitive-type + fixnum >>class [ alien-signed-2 ] >>getter [ set-alien-signed-2 ] >>setter 2 >>size @@ -378,6 +394,7 @@ M: long-long-type box-return ( type -- ) "short" define-primitive-type + fixnum >>class [ alien-unsigned-2 ] >>getter [ set-alien-unsigned-2 ] >>setter 2 >>size @@ -387,6 +404,7 @@ M: long-long-type box-return ( type -- ) "ushort" define-primitive-type + fixnum >>class [ alien-signed-1 ] >>getter [ set-alien-signed-1 ] >>setter 1 >>size @@ -396,6 +414,7 @@ M: long-long-type box-return ( type -- ) "char" define-primitive-type + fixnum >>class [ alien-unsigned-1 ] >>getter [ set-alien-unsigned-1 ] >>setter 1 >>size @@ -414,6 +433,7 @@ M: long-long-type box-return ( type -- ) "bool" define-primitive-type + float >>class [ alien-float ] >>getter [ [ >float ] 2dip set-alien-float ] >>setter 4 >>size @@ -425,6 +445,7 @@ M: long-long-type box-return ( type -- ) "float" define-primitive-type + float >>class [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size From 1c0789e616b2445a83962f10ba97b8587573dc79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 03:46:57 -0600 Subject: [PATCH 2/8] Didn't generate ##branch after ##alien-invoke and ##alien-indirect --- basis/compiler/cfg/builder/builder.factor | 2 +- basis/compiler/tests/codegen.factor | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index fdc0032a10..9ffe4a6aa0 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -260,7 +260,7 @@ M: #terminate emit-node drop stop-iterating ; : emit-alien-node ( node quot -- next ) [ params>> ] dip [ drop alien-stack-frame ] [ call ] 2bi - begin-basic-block iterate-next ; inline + ##branch begin-basic-block iterate-next ; inline M: #alien-invoke emit-node [ ##alien-invoke ] emit-alien-node ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index eb818972fc..7fbec43b60 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -261,3 +261,15 @@ TUPLE: id obj ; [ 3 ] [ 1 t fixnum-overflow-control-flow-test ] unit-test [ 2 ] [ 1 f fixnum-overflow-control-flow-test ] unit-test + +! LOL +: blah ( a -- b ) + { float } declare dup 0 = + [ drop 1 ] [ + dup 0 >= + [ 2 "double" "libm" "pow" { "double" "double" } alien-invoke ] + [ -0.5 "double" "libm" "pow" { "double" "double" } alien-invoke ] + if + ] if ; + +[ 4.0 ] [ 2.0 blah ] unit-test From 86d45262dcc3151dac18f2dfc8bfba3b8087289b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 03:47:38 -0600 Subject: [PATCH 3/8] Add toutput ype propagation for #alien-invoke and #alien-indirect nodes --- .../known-words/known-words.factor | 32 ++++--------------- .../tree/propagation/propagation-tests.factor | 6 +++- .../tree/propagation/simple/simple.factor | 15 +++++---- 3 files changed, 20 insertions(+), 33 deletions(-) diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index f6e2bc0940..163b17094a 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -37,31 +37,6 @@ most-negative-fixnum most-positive-fixnum [a,b] \ bitnot { integer } "input-classes" set-word-prop -{ - fcosh - flog - fsinh - fexp - fasin - facosh - fasinh - ftanh - fatanh - facos - fpow - fatan - fatan2 - fcos - ftan - fsin - fsqrt -} [ - dup stack-effect - [ in>> length real "input-classes" set-word-prop ] - [ out>> length float "default-output-classes" set-word-prop ] - 2bi -] each - : ?change-interval ( info quot -- quot' ) over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline @@ -222,8 +197,15 @@ generic-comparison-ops [ { { >fixnum fixnum } + { bignum>fixnum fixnum } + { >bignum bignum } + { fixnum>bignum bignum } + { float>bignum bignum } + { >float float } + { fixnum>float float } + { bignum>float float } } [ '[ _ diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 760ff167aa..5a7b096039 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -8,7 +8,7 @@ math.functions math.private strings layouts compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals -float-arrays system sorting ; +float-arrays system sorting math.libm ; IN: compiler.tree.propagation.tests \ propagate must-infer @@ -594,6 +594,10 @@ MIXIN: empty-mixin [ V{ array } ] [ [ [ <=> ] sort [ <=> ] sort ] final-classes ] unit-test +[ V{ float } ] [ [ fsqrt ] final-classes ] unit-test + +[ V{ t } ] [ [ { fixnum } declare 10 mod >float -20 > ] final-literals ] unit-test + ! [ V{ string } ] [ ! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ! ] unit-test diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index d586ff398f..9937c6b9c4 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: fry accessors kernel sequences sequences.private assocs words namespaces classes.algebra combinators classes classes.tuple -classes.tuple.private continuations arrays +classes.tuple.private continuations arrays alien.c-types math math.private slots generic definitions stack-checker.state compiler.tree @@ -137,11 +137,12 @@ M: #call propagate-after dup word>> "input-classes" word-prop dup [ propagate-input-classes ] [ 2drop ] if ; -M: #alien-invoke propagate-before - out-d>> [ object-info swap set-value-info ] each ; +: propagate-alien-invoke ( node -- ) + [ out-d>> ] [ params>> return>> ] bi + [ drop ] [ c-type-class swap first set-value-info ] if-void ; -M: #alien-indirect propagate-before - out-d>> [ object-info swap set-value-info ] each ; +M: #alien-invoke propagate-before propagate-alien-invoke ; -M: #return annotate-node - dup in-d>> (annotate-node) ; +M: #alien-indirect propagate-before propagate-alien-invoke ; + +M: #return annotate-node dup in-d>> (annotate-node) ; From e1578b5848ebafc3107e4e3509b5fa787f79b02c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 03:49:24 -0600 Subject: [PATCH 4/8] Tweak math.functions to inline better --- basis/math/functions/functions.factor | 81 ++++++++++++++++----------- basis/math/libm/libm.factor | 34 +++++------ 2 files changed, 66 insertions(+), 49 deletions(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index c582c560a9..1cea0a74dd 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -100,7 +100,7 @@ PRIVATE> { [ dup integer? ] [ integer^ ] } { [ 2dup real^? ] [ fpow ] } [ ^complex ] - } cond ; + } cond ; inline : (^mod) ( n x y -- z ) 1 swap [ @@ -174,47 +174,61 @@ M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ; M: complex log >polar swap flog swap rect> ; -: cos ( x -- y ) - dup complex? [ - >float-rect 2dup - fcosh swap fcos * -rot - fsinh swap fsin neg * rect> - ] [ fcos ] if ; foldable +GENERIC: cos ( x -- y ) foldable + +M: complex cos + >float-rect 2dup + fcosh swap fcos * -rot + fsinh swap fsin neg * rect> ; + +M: real cos fcos ; : sec ( x -- y ) cos recip ; inline -: cosh ( x -- y ) - dup complex? [ - >float-rect 2dup - fcos swap fcosh * -rot - fsin swap fsinh * rect> - ] [ fcosh ] if ; foldable +GENERIC: cosh ( x -- y ) foldable + +M: complex cosh + >float-rect 2dup + fcos swap fcosh * -rot + fsin swap fsinh * rect> ; + +M: real cosh fcosh ; : sech ( x -- y ) cosh recip ; inline -: sin ( x -- y ) - dup complex? [ - >float-rect 2dup - fcosh swap fsin * -rot - fsinh swap fcos * rect> - ] [ fsin ] if ; foldable +GENERIC: sin ( x -- y ) foldable + +M: complex sin + >float-rect 2dup + fcosh swap fsin * -rot + fsinh swap fcos * rect> ; + +M: real sin fsin ; : cosec ( x -- y ) sin recip ; inline -: sinh ( x -- y ) - dup complex? [ - >float-rect 2dup - fcos swap fsinh * -rot - fsin swap fcosh * rect> - ] [ fsinh ] if ; foldable +GENERIC: sinh ( x -- y ) foldable + +M: complex sinh + >float-rect 2dup + fcos swap fsinh * -rot + fsin swap fcosh * rect> ; + +M: real sinh fsinh ; : cosech ( x -- y ) sinh recip ; inline -: tan ( x -- y ) - dup complex? [ dup sin swap cos / ] [ ftan ] if ; inline +GENERIC: tan ( x -- y ) foldable -: tanh ( x -- y ) - dup complex? [ dup sinh swap cosh / ] [ ftanh ] if ; inline +M: complex tan [ sin ] [ cos ] bi / ; + +M: real tan ftan ; + +GENERIC: tanh ( x -- y ) foldable + +M: complex tanh [ sinh ] [ cosh ] bi / ; + +M: real tanh ftanh ; : cot ( x -- y ) tan recip ; inline @@ -231,7 +245,7 @@ M: complex log >polar swap flog swap rect> ; : acosech ( x -- y ) recip asinh ; inline : atanh ( x -- y ) - dup 1+ swap 1- neg / log 2 / ; inline + [ 1+ ] [ 1- neg ] bi / log 2 / ; inline : acoth ( x -- y ) recip atanh ; inline @@ -246,8 +260,11 @@ M: complex log >polar swap flog swap rect> ; dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ; inline -: atan ( x -- y ) - dup complex? [ i* atanh i* ] [ fatan ] if ; inline +GENERIC: atan ( x -- y ) foldable + +M: complex atan i* atanh i* ; + +M: real atan fatan ; : asec ( x -- y ) recip acos ; inline diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor index 8bda6a6dd0..96f5f134cc 100644 --- a/basis/math/libm/libm.factor +++ b/basis/math/libm/libm.factor @@ -5,69 +5,69 @@ IN: math.libm : facos ( x -- y ) "double" "libm" "acos" { "double" } alien-invoke ; - foldable + inline : fasin ( x -- y ) "double" "libm" "asin" { "double" } alien-invoke ; - foldable + inline : fatan ( x -- y ) "double" "libm" "atan" { "double" } alien-invoke ; - foldable + inline : fatan2 ( x y -- z ) "double" "libm" "atan2" { "double" "double" } alien-invoke ; - foldable + inline : fcos ( x -- y ) "double" "libm" "cos" { "double" } alien-invoke ; - foldable + inline : fsin ( x -- y ) "double" "libm" "sin" { "double" } alien-invoke ; - foldable + inline : ftan ( x -- y ) "double" "libm" "tan" { "double" } alien-invoke ; - foldable + inline : fcosh ( x -- y ) "double" "libm" "cosh" { "double" } alien-invoke ; - foldable + inline : fsinh ( x -- y ) "double" "libm" "sinh" { "double" } alien-invoke ; - foldable + inline : ftanh ( x -- y ) "double" "libm" "tanh" { "double" } alien-invoke ; - foldable + inline : fexp ( x -- y ) "double" "libm" "exp" { "double" } alien-invoke ; - foldable + inline : flog ( x -- y ) "double" "libm" "log" { "double" } alien-invoke ; - foldable + inline : fpow ( x y -- z ) "double" "libm" "pow" { "double" "double" } alien-invoke ; - foldable + inline : fsqrt ( x -- y ) "double" "libm" "sqrt" { "double" } alien-invoke ; - foldable + inline ! Windows doesn't have these... : facosh ( x -- y ) "double" "libm" "acosh" { "double" } alien-invoke ; - foldable + inline : fasinh ( x -- y ) "double" "libm" "asinh" { "double" } alien-invoke ; - foldable + inline : fatanh ( x -- y ) "double" "libm" "atanh" { "double" } alien-invoke ; - foldable + inline From 24b8bc5a4fd801200d318ad8ead582659fc33291 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 03:50:17 -0600 Subject: [PATCH 5/8] Clean up and shorten partial-sums; tweak it to not use float-mod --- .../partial-sums/partial-sums.factor | 87 +++++++------------ 1 file changed, 33 insertions(+), 54 deletions(-) diff --git a/extra/benchmark/partial-sums/partial-sums.factor b/extra/benchmark/partial-sums/partial-sums.factor index 2d8cdc40c7..cb631aeb38 100644 --- a/extra/benchmark/partial-sums/partial-sums.factor +++ b/extra/benchmark/partial-sums/partial-sums.factor @@ -1,63 +1,42 @@ -USING: math math.functions kernel sequences io io.styles -prettyprint words hints ; +USING: math math.functions kernel io io.styles +prettyprint combinators hints fry namespaces ; IN: benchmark.partial-sums -: summing ( n quot -- y ) - [ >float ] swap [ + ] 3compose - 0.0 -rot 1 -rot (each-integer) ; inline - -: 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing ; - -HINTS: 2/3^k fixnum ; - -: k^-0.5 ( n -- y ) [ -0.5 ^ ] summing ; - -HINTS: k^-0.5 fixnum ; - -: 1/k(k+1) ( n -- y ) [ dup 1+ * recip ] summing ; - -HINTS: 1/k(k+1) fixnum ; - +! Helper words +: summing-integers ( n quot -- y ) [ 0.0 1 ] 2dip '[ @ + ] (each-integer) ; inline +: summing-floats ( n quot -- y ) '[ >float @ ] summing-integers ; inline : cube ( x -- y ) dup dup * * ; inline +: -1^ 2 mod 2 * 1- ; inline -: flint-hills ( n -- y ) - [ dup cube swap sin sq * recip ] summing ; +! The functions +: 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing-floats ; inline +: k^-0.5 ( n -- y ) [ -0.5 ^ ] summing-floats ; inline +: 1/k(k+1) ( n -- y ) [ dup 1+ * recip ] summing-floats ; inline +: flint-hills ( n -- y ) [ [ cube ] [ sin sq ] bi * recip ] summing-floats ; inline +: cookson-hills ( n -- y ) [ [ cube ] [ cos sq ] bi * recip ] summing-floats ; inline +: harmonic ( n -- y ) [ recip ] summing-floats ; inline +: riemann-zeta ( n -- y ) [ sq recip ] summing-floats ; inline +: alternating-harmonic ( n -- y ) [ [ -1^ ] keep /f ] summing-integers ; inline +: gregory ( n -- y ) [ [ -1^ ] [ 2.0 * 1- ] bi / ] summing-integers ; inline -HINTS: flint-hills fixnum ; +: partial-sums ( n -- results ) + [ + { + [ 2/3^k \ 2/3^k set ] + [ k^-0.5 \ k^-0.5 set ] + [ 1/k(k+1) \ 1/k(k+1) set ] + [ flint-hills \ flint-hills set ] + [ cookson-hills \ cookson-hills set ] + [ harmonic \ harmonic set ] + [ riemann-zeta \ riemann-zeta set ] + [ alternating-harmonic \ alternating-harmonic set ] + [ gregory \ gregory set ] + } cleave + ] { } make-assoc ; -: cookson-hills ( n -- y ) - [ dup cube swap cos sq * recip ] summing ; +HINTS: partial-sums fixnum ; -HINTS: cookson-hills fixnum ; - -: harmonic ( n -- y ) [ recip ] summing ; - -HINTS: harmonic fixnum ; - -: riemann-zeta ( n -- y ) [ sq recip ] summing ; - -HINTS: riemann-zeta fixnum ; - -: -1^ 2 mod zero? 1 -1 ? ; inline - -: alternating-harmonic ( n -- y ) [ dup -1^ swap / ] summing ; - -HINTS: alternating-harmonic fixnum ; - -: gregory ( n -- y ) [ dup -1^ swap 2 * 1- / ] summing ; - -HINTS: gregory fixnum ; - -: functions - { 2/3^k k^-0.5 1/k(k+1) flint-hills cookson-hills harmonic riemann-zeta alternating-harmonic gregory } ; - -: partial-sums ( n -- ) - standard-table-style [ - functions [ - [ tuck execute pprint-cell pprint-cell ] with-row - ] with each - ] tabular-output ; - -: partial-sums-main ( -- ) 2500000 partial-sums ; +: partial-sums-main ( -- ) + 2500001 partial-sums simple-table. ; MAIN: partial-sums-main From 2798de019a1b07c420e3982ce99ed7fdf36fb82e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 04:09:16 -0600 Subject: [PATCH 6/8] Faster --- basis/math/ranges/ranges.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 41fd28e441..388d117959 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: kernel layouts math math.order namespaces sequences sequences.private accessors ; IN: math.ranges @@ -8,9 +10,7 @@ TUPLE: range { step read-only } ; : ( a b step -- range ) - [ over - ] dip - [ / 1+ 0 max >integer ] keep - range boa ; inline + [ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline M: range length ( seq -- n ) length>> ; From 87d00d8012a0d4264e934f61ce39fb4c7ad58717 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 04:14:30 -0600 Subject: [PATCH 7/8] Clean up --- extra/benchmark/partial-sums/partial-sums.factor | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/extra/benchmark/partial-sums/partial-sums.factor b/extra/benchmark/partial-sums/partial-sums.factor index cb631aeb38..7c7c68b12d 100644 --- a/extra/benchmark/partial-sums/partial-sums.factor +++ b/extra/benchmark/partial-sums/partial-sums.factor @@ -1,12 +1,14 @@ -USING: math math.functions kernel io io.styles -prettyprint combinators hints fry namespaces ; +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: math math.functions kernel io io.styles prettyprint +combinators hints fry namespaces sequences ; IN: benchmark.partial-sums ! Helper words -: summing-integers ( n quot -- y ) [ 0.0 1 ] 2dip '[ @ + ] (each-integer) ; inline +: summing-integers ( n quot -- y ) [ 0.0 ] 2dip '[ 1+ @ + ] each ; inline : summing-floats ( n quot -- y ) '[ >float @ ] summing-integers ; inline : cube ( x -- y ) dup dup * * ; inline -: -1^ 2 mod 2 * 1- ; inline +: -1^ ( n -- -1/1 ) 2 mod 2 * 1- ; inline ! The functions : 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing-floats ; inline @@ -37,6 +39,6 @@ IN: benchmark.partial-sums HINTS: partial-sums fixnum ; : partial-sums-main ( -- ) - 2500001 partial-sums simple-table. ; + 2500000 partial-sums simple-table. ; MAIN: partial-sums-main From f72f9a8f45dc1e6b722d2c775ec599512488d73b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Nov 2008 04:59:29 -0600 Subject: [PATCH 8/8] Add required methods --- basis/alien/arrays/arrays.factor | 2 ++ basis/alien/strings/strings.factor | 3 +++ basis/alien/structs/structs.factor | 2 ++ 3 files changed, 7 insertions(+) diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index 94472e8261..727492edb1 100644 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -8,6 +8,8 @@ UNION: value-type array struct-type ; M: array c-type ; +M: array c-type-class drop object ; + M: array heap-size unclip heap-size [ * ] reduce ; M: array c-type-align first c-type-align ; diff --git a/basis/alien/strings/strings.factor b/basis/alien/strings/strings.factor index 70bbe773ee..b0faadb7fc 100644 --- a/basis/alien/strings/strings.factor +++ b/basis/alien/strings/strings.factor @@ -40,6 +40,9 @@ PREDICATE: string-type < pair M: string-type c-type ; +M: string-type c-type-class + drop object ; + M: string-type heap-size drop "void*" heap-size ; diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index adb25aa977..1131b1eecd 100644 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -9,6 +9,8 @@ TUPLE: struct-type size align fields ; M: struct-type heap-size size>> ; +M: struct-type c-type-class drop object ; + M: struct-type c-type-align align>> ; M: struct-type c-type-stack-align? drop f ;