Remove some usages of deprecated features

db4
Slava Pestov 2008-06-30 05:22:05 -05:00
parent b9aa005310
commit dea3604264
9 changed files with 29 additions and 44 deletions

View File

@ -81,8 +81,9 @@ M: mixin-instance hashcode*
[ class>> ] [ mixin>> ] bi 2array hashcode* ;
: <mixin-instance> ( class mixin -- definition )
{ set-mixin-instance-class set-mixin-instance-mixin }
mixin-instance construct ;
mixin-instance new
swap >>mixin
swap >>class ;
M: mixin-instance where mixin-instance-loc ;

View File

@ -11,14 +11,5 @@ TUPLE: color red green blue ;
[ { color-red color-blue } get-slots ] compile-call
] unit-test
[ T{ color f 10 2 20 } ] [
10 20
1 2 3 color boa [
[
{ set-color-red set-color-blue } set-slots
] compile-call
] keep
] unit-test
[ T{ color f f f f } ]
[ [ color new ] compile-call ] unit-test

View File

@ -195,7 +195,9 @@ INSTANCE: constant value
#! temp then temp to the destination.
temp-reg over %move
operand-class temp-reg
{ set-operand-class set-tagged-vreg } tagged construct
tagged new
swap >>vreg
swap >>class
%move ;
: %move ( dst src -- )

View File

@ -12,8 +12,3 @@ HELP: define-transform
$nl
"The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":"
{ $code "\\ cond [ cond>quot ] 1 define-transform" } } ;
HELP: duplicated-slots-error
{ $values { "names" "a sequence of setter words" } }
{ $description "Throws a " { $link duplicated-slots-error } "." }
{ $error-description "Thrown by stack effect inference if a " { $link set-slots } " form is given an array of slot setters that includes duplicates. Since writing to the same slot multiple times has no useful effect, this is a programmer error, so it is caught at compile time." } ;

View File

@ -39,9 +39,9 @@ uses definitions ;
new-definitions get swap set-source-file-definitions ;
: <source-file> ( path -- source-file )
<definitions>
{ set-source-file-path set-source-file-definitions }
\ source-file construct ;
\ source-file new
swap >>path
<definitions> >>definitions ;
: source-file ( path -- source-file )
dup string? [ "Invalid source file path" throw ] unless

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs strings kernel sorting namespaces sequences
definitions ;
USING: accessors assocs strings kernel sorting namespaces
sequences definitions ;
IN: vocabs
SYMBOL: dictionary
@ -12,9 +12,9 @@ main help
source-loaded? docs-loaded? ;
: <vocab> ( name -- vocab )
H{ } clone
{ set-vocab-name set-vocab-words }
\ vocab construct ;
\ vocab new
swap >>name
H{ } clone >>words ;
GENERIC: vocab ( vocab-spec -- vocab )

View File

@ -12,8 +12,10 @@ SYMBOL: last-drag-loc
TUPLE: demo-gadget yaw pitch distance ;
: <demo-gadget> ( yaw pitch distance -- gadget )
demo-gadget construct-gadget
[ { (>>yaw) (>>pitch) (>>distance) } set-slots ] keep ;
demo-gadget construct-gadget
swap >>distance
swap >>pitch
swap >>yaw ;
GENERIC: far-plane ( gadget -- z )
GENERIC: near-plane ( gadget -- z )

View File

@ -35,13 +35,13 @@ pango_ft2_render_layout ( FT_Bitmap* bitmap, PangoLayout* layout, int x, int y )
FT_PIXEL_MODE_GRAY
"FT_Bitmap" <c-object> dup >r
{
set-FT_Bitmap-rows
set-FT_Bitmap-width
set-FT_Bitmap-pitch
set-FT_Bitmap-buffer
set-FT_Bitmap-num_grays
set-FT_Bitmap-pixel_mode
} set-slots r> ;
[ set-FT_Bitmap-pixel_mode ]
[ set-FT_Bitmap-num_grays ]
[ set-FT_Bitmap-buffer ]
[ set-FT_Bitmap-pitch ]
[ set-FT_Bitmap-width ]
[ set-FT_Bitmap-rows ]
} cleave r> ;
: render-layout ( layout -- dims alien )
[

View File

@ -23,17 +23,11 @@ no-word-sep
finalized?
;
: init-rule-set ( ruleset -- )
#! Call after constructor.
>r H{ } clone H{ } clone V{ } clone r>
{
set-rule-set-rules
set-rule-set-props
set-rule-set-imports
} set-slots ;
: <rule-set> ( -- ruleset )
rule-set new dup init-rule-set ;
rule-set new
H{ } clone >>rules
H{ } clone >>props
V{ } clone >>imports ;
MEMO: standard-rule-set ( id -- ruleset )
<rule-set> [ set-rule-set-default ] keep ;