Remove some usages of deprecated features
parent
b9aa005310
commit
dea3604264
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue