Fix some vocabularies for new requirement that inline words have a stack effect declaration

db4
Slava Pestov 2008-12-15 20:31:55 -06:00
parent febdfd4812
commit 09c60f7e90
15 changed files with 139 additions and 137 deletions

View File

@ -189,19 +189,19 @@ MTSPR: LR 8
MTSPR: CTR 9 MTSPR: CTR 9
! Pseudo-instructions ! Pseudo-instructions
: LI 0 rot ADDI ; inline : LI ( value dst -- ) 0 rot ADDI ; inline
: SUBI neg ADDI ; inline : SUBI ( dst src1 src2 -- ) neg ADDI ; inline
: LIS 0 rot ADDIS ; inline : LIS ( value dst -- ) 0 rot ADDIS ; inline
: SUBIC neg ADDIC ; inline : SUBIC ( dst src1 src2 -- ) neg ADDIC ; inline
: SUBIC. neg ADDIC. ; inline : SUBIC. ( dst src1 src2 -- ) neg ADDIC. ; inline
: NOT dup NOR ; inline : NOT ( dst src -- ) dup NOR ; inline
: NOT. dup NOR. ; inline : NOT. ( dst src -- ) dup NOR. ; inline
: MR dup OR ; inline : MR ( dst src -- ) dup OR ; inline
: MR. dup OR. ; inline : MR. ( dst src -- ) dup OR. ; inline
: (SLWI) 0 31 pick - ; inline : (SLWI) ( d a b -- d a b x y ) 0 31 pick - ; inline
: SLWI ( d a b -- ) (SLWI) RLWINM ; : SLWI ( d a b -- ) (SLWI) RLWINM ;
: SLWI. ( d a b -- ) (SLWI) RLWINM. ; : SLWI. ( d a b -- ) (SLWI) RLWINM. ;
: (SRWI) 32 over - swap 31 ; inline : (SRWI) ( d a b -- d a b x y ) 32 over - swap 31 ; inline
: SRWI ( d a b -- ) (SRWI) RLWINM ; : SRWI ( d a b -- ) (SRWI) RLWINM ;
: SRWI. ( d a b -- ) (SRWI) RLWINM. ; : SRWI. ( d a b -- ) (SRWI) RLWINM. ;
: LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ; : LOAD32 ( n r -- ) >r w>h/h r> tuck LIS dup rot ORI ;

View File

@ -10,7 +10,7 @@ IN: math.quaternions
<PRIVATE <PRIVATE
: ** conjugate * ; inline : ** ( x y -- z ) conjugate * ; inline
: 2q ( u v -- u' u'' v' v'' ) [ first2 ] bi@ ; inline : 2q ( u v -- u' u'' v' v'' ) [ first2 ] bi@ ; inline

View File

@ -12,7 +12,7 @@ TUPLE: nibble-array
: nibble BIN: 1111 ; inline : nibble BIN: 1111 ; inline
: nibbles>bytes 1 + 2/ ; inline : nibbles>bytes ( m -- n ) 1 + 2/ ; inline
: byte/nibble ( n -- shift n' ) : byte/nibble ( n -- shift n' )
[ 1 bitand 2 shift ] [ -1 shift ] bi ; inline [ 1 bitand 2 shift ] [ -1 shift ] bi ; inline

View File

@ -22,9 +22,9 @@ M: persistent-vector length count>> ;
: node-size 32 ; inline : node-size 32 ; inline
: node-mask node-size mod ; inline : node-mask ( m -- n ) node-size mod ; inline
: node-shift -5 * shift ; inline : node-shift ( m n -- x ) -5 * shift ; inline
: node-nth ( i node -- obj ) : node-nth ( i node -- obj )
[ node-mask ] [ children>> ] bi* nth ; [ node-mask ] [ children>> ] bi* nth ;

View File

@ -18,7 +18,7 @@ WHERE
TUPLE: V { underlying A } { length array-capacity } ; TUPLE: V { underlying A } { length array-capacity } ;
: <V> <A> execute 0 V boa ; inline : <V> ( capacity -- vector ) <A> execute 0 V boa ; inline
M: V like M: V like
drop dup V instance? [ drop dup V instance? [
@ -31,7 +31,7 @@ M: A new-resizable drop <V> execute ;
M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ; M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
: >V V new clone-like ; inline : >V ( seq -- vector ) V new clone-like ; inline
M: V pprint-delims drop V{ \ } ; M: V pprint-delims drop V{ \ } ;

View File

@ -17,7 +17,8 @@ M: vlist nth-unsafe vector>> nth-unsafe ;
<PRIVATE <PRIVATE
: >vlist< [ length>> ] [ vector>> ] bi ; inline : >vlist< ( vlist -- len vec )
[ length>> ] [ vector>> ] bi ; inline
: unshare ( len vec -- len vec' ) : unshare ( len vec -- len vec' )
clone [ set-length ] 2keep ; inline clone [ set-length ] 2keep ; inline

View File

@ -13,7 +13,7 @@
USING: kernel arrays alien alien.c-types alien.strings USING: kernel arrays alien alien.c-types alien.strings
alien.syntax math math.bitwise words sequences namespaces alien.syntax math math.bitwise words sequences namespaces
continuations io io.encodings.ascii ; continuations io io.encodings.ascii alias ;
IN: x11.xlib IN: x11.xlib
LIBRARY: xlib LIBRARY: xlib
@ -50,17 +50,17 @@ TYPEDEF: ulong Time
TYPEDEF: void* Window** TYPEDEF: void* Window**
TYPEDEF: void* Atom** TYPEDEF: void* Atom**
: <XID> <ulong> ; inline ALIAS: <XID> <ulong>
: <Window> <XID> ; inline ALIAS: <Window> <XID>
: <Drawable> <XID> ; inline ALIAS: <Drawable> <XID>
: <KeySym> <XID> ; inline ALIAS: <KeySym> <XID>
: <Atom> <ulong> ; inline ALIAS: <Atom> <ulong>
: *XID *ulong ; inline ALIAS: *XID *ulong
: *Window *XID ; inline ALIAS: *Window *XID
: *Drawable *XID ; inline ALIAS: *Drawable *XID
: *KeySym *XID ; inline ALIAS: *KeySym *XID
: *Atom *ulong ; inline ALIAS: *Atom *ulong
! !
! 2 - Display Functions ! 2 - Display Functions
! !
@ -98,21 +98,21 @@ FUNCTION: int XCloseDisplay ( Display* display ) ;
! 3.2 - Window Attributes ! 3.2 - Window Attributes
: CWBackPixmap 1 0 shift ; inline : CWBackPixmap ( -- n ) 0 2^ ; inline
: CWBackPixel 1 1 shift ; inline : CWBackPixel ( -- n ) 1 2^ ; inline
: CWBorderPixmap 1 2 shift ; inline : CWBorderPixmap ( -- n ) 2 2^ ; inline
: CWBorderPixel 1 3 shift ; inline : CWBorderPixel ( -- n ) 3 2^ ; inline
: CWBitGravity 1 4 shift ; inline : CWBitGravity ( -- n ) 4 2^ ; inline
: CWWinGravity 1 5 shift ; inline : CWWinGravity ( -- n ) 5 2^ ; inline
: CWBackingStore 1 6 shift ; inline : CWBackingStore ( -- n ) 6 2^ ; inline
: CWBackingPlanes 1 7 shift ; inline : CWBackingPlanes ( -- n ) 7 2^ ; inline
: CWBackingPixel 1 8 shift ; inline : CWBackingPixel ( -- n ) 8 2^ ; inline
: CWOverrideRedirect 1 9 shift ; inline : CWOverrideRedirect ( -- n ) 9 2^ ; inline
: CWSaveUnder 1 10 shift ; inline : CWSaveUnder ( -- n ) 10 2^ ; inline
: CWEventMask 1 11 shift ; inline : CWEventMask ( -- n ) 11 2^ ; inline
: CWDontPropagate 1 12 shift ; inline : CWDontPropagate ( -- n ) 12 2^ ; inline
: CWColormap 1 13 shift ; inline : CWColormap ( -- n ) 13 2^ ; inline
: CWCursor 1 14 shift ; inline : CWCursor ( -- n ) 14 2^ ; inline
C-STRUCT: XSetWindowAttributes C-STRUCT: XSetWindowAttributes
{ "Pixmap" "background_pixmap" } { "Pixmap" "background_pixmap" }
@ -161,13 +161,13 @@ FUNCTION: int XMapRaised ( Display* display, Window w ) ;
! 3.7 - Configuring Windows ! 3.7 - Configuring Windows
: CWX 1 0 shift ; inline : CWX ( -- n ) 0 2^ ; inline
: CWY 1 1 shift ; inline : CWY ( -- n ) 1 2^ ; inline
: CWWidth 1 2 shift ; inline : CWWidth ( -- n ) 2 2^ ; inline
: CWHeight 1 3 shift ; inline : CWHeight ( -- n ) 3 2^ ; inline
: CWBorderWidth 1 4 shift ; inline : CWBorderWidth ( -- n ) 4 2^ ; inline
: CWSibling 1 5 shift ; inline : CWSibling ( -- n ) 5 2^ ; inline
: CWStackMode 1 6 shift ; inline : CWStackMode ( -- n ) 6 2^ ; inline
C-STRUCT: XWindowChanges C-STRUCT: XWindowChanges
{ "int" "x" } { "int" "x" }
@ -312,29 +312,29 @@ FUNCTION: Colormap XCreateColormap ( Display* display, Window w, Visual* visual,
! 7 - Graphics Context Functions ! 7 - Graphics Context Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: GCFunction 1 0 shift ; inline : GCFunction ( -- n ) 0 2^ ; inline
: GCPlaneMask 1 1 shift ; inline : GCPlaneMask ( -- n ) 1 2^ ; inline
: GCForeground 1 2 shift ; inline : GCForeground ( -- n ) 2 2^ ; inline
: GCBackground 1 3 shift ; inline : GCBackground ( -- n ) 3 2^ ; inline
: GCLineWidth 1 4 shift ; inline : GCLineWidth ( -- n ) 4 2^ ; inline
: GCLineStyle 1 5 shift ; inline : GCLineStyle ( -- n ) 5 2^ ; inline
: GCCapStyle 1 6 shift ; inline : GCCapStyle ( -- n ) 6 2^ ; inline
: GCJoinStyle 1 7 shift ; inline : GCJoinStyle ( -- n ) 7 2^ ; inline
: GCFillStyle 1 8 shift ; inline : GCFillStyle ( -- n ) 8 2^ ; inline
: GCFillRule 1 9 shift ; inline : GCFillRule ( -- n ) 9 2^ ; inline
: GCTile 1 10 shift ; inline : GCTile ( -- n ) 10 2^ ; inline
: GCStipple 1 11 shift ; inline : GCStipple ( -- n ) 11 2^ ; inline
: GCTileStipXOrigin 1 12 shift ; inline : GCTileStipXOrigin ( -- n ) 12 2^ ; inline
: GCTileStipYOrigin 1 13 shift ; inline : GCTileStipYOrigin ( -- n ) 13 2^ ; inline
: GCFont 1 14 shift ; inline : GCFont ( -- n ) 14 2^ ; inline
: GCSubwindowMode 1 15 shift ; inline : GCSubwindowMode ( -- n ) 15 2^ ; inline
: GCGraphicsExposures 1 16 shift ; inline : GCGraphicsExposures ( -- n ) 16 2^ ; inline
: GCClipXOrigin 1 17 shift ; inline : GCClipXOrigin ( -- n ) 17 2^ ; inline
: GCClipYOrigin 1 18 shift ; inline : GCClipYOrigin ( -- n ) 18 2^ ; inline
: GCClipMask 1 19 shift ; inline : GCClipMask ( -- n ) 19 2^ ; inline
: GCDashOffset 1 20 shift ; inline : GCDashOffset ( -- n ) 20 2^ ; inline
: GCDashList 1 21 shift ; inline : GCDashList ( -- n ) 21 2^ ; inline
: GCArcMode 1 22 shift ; inline : GCArcMode ( -- n ) 22 2^ ; inline
: GXclear HEX: 0 ; inline : GXclear HEX: 0 ; inline
: GXand HEX: 1 ; inline : GXand HEX: 1 ; inline
@ -505,32 +505,32 @@ FUNCTION: Status XKillClient ( Display* display, XID resource ) ;
! 10.3 - Event Masks ! 10.3 - Event Masks
: NoEventMask 0 ; inline : NoEventMask ( -- n ) 0 ; inline
: KeyPressMask 1 0 shift ; inline : KeyPressMask ( -- n ) 0 2^ ; inline
: KeyReleaseMask 1 1 shift ; inline : KeyReleaseMask ( -- n ) 1 2^ ; inline
: ButtonPressMask 1 2 shift ; inline : ButtonPressMask ( -- n ) 2 2^ ; inline
: ButtonReleaseMask 1 3 shift ; inline : ButtonReleaseMask ( -- n ) 3 2^ ; inline
: EnterWindowMask 1 4 shift ; inline : EnterWindowMask ( -- n ) 4 2^ ; inline
: LeaveWindowMask 1 5 shift ; inline : LeaveWindowMask ( -- n ) 5 2^ ; inline
: PointerMotionMask 1 6 shift ; inline : PointerMotionMask ( -- n ) 6 2^ ; inline
: PointerMotionHintMask 1 7 shift ; inline : PointerMotionHintMask ( -- n ) 7 2^ ; inline
: Button1MotionMask 1 8 shift ; inline : Button1MotionMask ( -- n ) 8 2^ ; inline
: Button2MotionMask 1 9 shift ; inline : Button2MotionMask ( -- n ) 9 2^ ; inline
: Button3MotionMask 1 10 shift ; inline : Button3MotionMask ( -- n ) 10 2^ ; inline
: Button4MotionMask 1 11 shift ; inline : Button4MotionMask ( -- n ) 11 2^ ; inline
: Button5MotionMask 1 12 shift ; inline : Button5MotionMask ( -- n ) 12 2^ ; inline
: ButtonMotionMask 1 13 shift ; inline : ButtonMotionMask ( -- n ) 13 2^ ; inline
: KeymapStateMask 1 14 shift ; inline : KeymapStateMask ( -- n ) 14 2^ ; inline
: ExposureMask 1 15 shift ; inline : ExposureMask ( -- n ) 15 2^ ; inline
: VisibilityChangeMask 1 16 shift ; inline : VisibilityChangeMask ( -- n ) 16 2^ ; inline
: StructureNotifyMask 1 17 shift ; inline : StructureNotifyMask ( -- n ) 17 2^ ; inline
: ResizeRedirectMask 1 18 shift ; inline : ResizeRedirectMask ( -- n ) 18 2^ ; inline
: SubstructureNotifyMask 1 19 shift ; inline : SubstructureNotifyMask ( -- n ) 19 2^ ; inline
: SubstructureRedirectMask 1 20 shift ; inline : SubstructureRedirectMask ( -- n ) 20 2^ ; inline
: FocusChangeMask 1 21 shift ; inline : FocusChangeMask ( -- n ) 21 2^ ; inline
: PropertyChangeMask 1 22 shift ; inline : PropertyChangeMask ( -- n ) 22 2^ ; inline
: ColormapChangeMask 1 23 shift ; inline : ColormapChangeMask ( -- n ) 23 2^ ; inline
: OwnerGrabButtonMask 1 24 shift ; inline : OwnerGrabButtonMask ( -- n ) 24 2^ ; inline
: KeyPress 2 ; inline : KeyPress 2 ; inline
: KeyRelease 3 ; inline : KeyRelease 3 ; inline
@ -584,20 +584,20 @@ C-STRUCT: XAnyEvent
: Button4 4 ; inline : Button4 4 ; inline
: Button5 5 ; inline : Button5 5 ; inline
: Button1Mask 1 8 shift ; inline : Button1Mask ( -- n ) 1 8 shift ; inline
: Button2Mask 1 9 shift ; inline : Button2Mask ( -- n ) 1 9 shift ; inline
: Button3Mask 1 10 shift ; inline : Button3Mask ( -- n ) 1 10 shift ; inline
: Button4Mask 1 11 shift ; inline : Button4Mask ( -- n ) 1 11 shift ; inline
: Button5Mask 1 12 shift ; inline : Button5Mask ( -- n ) 1 12 shift ; inline
: ShiftMask 1 0 shift ; inline : ShiftMask ( -- n ) 1 0 shift ; inline
: LockMask 1 1 shift ; inline : LockMask ( -- n ) 1 1 shift ; inline
: ControlMask 1 2 shift ; inline : ControlMask ( -- n ) 1 2 shift ; inline
: Mod1Mask 1 3 shift ; inline : Mod1Mask ( -- n ) 1 3 shift ; inline
: Mod2Mask 1 4 shift ; inline : Mod2Mask ( -- n ) 1 4 shift ; inline
: Mod3Mask 1 5 shift ; inline : Mod3Mask ( -- n ) 1 5 shift ; inline
: Mod4Mask 1 6 shift ; inline : Mod4Mask ( -- n ) 1 6 shift ; inline
: Mod5Mask 1 7 shift ; inline : Mod5Mask ( -- n ) 1 7 shift ; inline
C-STRUCT: XButtonEvent C-STRUCT: XButtonEvent
{ "int" "type" } { "int" "type" }
@ -1321,15 +1321,15 @@ FUNCTION: int XBell ( Display* display, int percent ) ;
! !!! INPUT METHODS ! !!! INPUT METHODS
: XIMPreeditArea HEX: 0001 ; : XIMPreeditArea HEX: 0001 ; inline
: XIMPreeditCallbacks HEX: 0002 ; : XIMPreeditCallbacks HEX: 0002 ; inline
: XIMPreeditPosition HEX: 0004 ; : XIMPreeditPosition HEX: 0004 ; inline
: XIMPreeditNothing HEX: 0008 ; : XIMPreeditNothing HEX: 0008 ; inline
: XIMPreeditNone HEX: 0010 ; : XIMPreeditNone HEX: 0010 ; inline
: XIMStatusArea HEX: 0100 ; : XIMStatusArea HEX: 0100 ; inline
: XIMStatusCallbacks HEX: 0200 ; : XIMStatusCallbacks HEX: 0200 ; inline
: XIMStatusNothing HEX: 0400 ; : XIMStatusNothing HEX: 0400 ; inline
: XIMStatusNone HEX: 0800 ; : XIMStatusNone HEX: 0800 ; inline
: XNVaNestedList "XNVaNestedList" ; : XNVaNestedList "XNVaNestedList" ;
: XNQueryInputStyle "queryInputStyle" ; : XNQueryInputStyle "queryInputStyle" ;

View File

@ -2,7 +2,7 @@ USING: accessors sequences assocs kernel quotations namespaces
xml.data xml.utilities combinators macros parser lexer words fry ; xml.data xml.utilities combinators macros parser lexer words fry ;
IN: xmode.utilities IN: xmode.utilities
: implies [ not ] dip or ; inline : implies ( x y -- z ) [ not ] dip or ; inline
: child-tags ( tag -- seq ) children>> [ tag? ] filter ; : child-tags ( tag -- seq ) children>> [ tag? ] filter ;

View File

@ -6,8 +6,8 @@ io.encodings.binary fry benchmark.mandel.params
benchmark.mandel.colors ; benchmark.mandel.colors ;
IN: benchmark.mandel IN: benchmark.mandel
: x-inc width 200000 zoom-fact * / ; inline : x-inc ( -- x ) width 200000 zoom-fact * / ; inline
: y-inc height 150000 zoom-fact * / ; inline : y-inc ( -- y ) height 150000 zoom-fact * / ; inline
: c ( i j -- c ) : c ( i j -- c )
[ x-inc * center real-part x-inc width 2 / * - + >float ] [ x-inc * center real-part x-inc width 2 / * - + >float ]

View File

@ -5,7 +5,7 @@ math.constants math.functions math.vectors prettyprint
sequences hints arrays ; sequences hints arrays ;
IN: benchmark.nbody IN: benchmark.nbody
: solar-mass 4 pi sq * ; inline : solar-mass ( -- x ) 4 pi sq * ; inline
: days-per-year 365.24 ; inline : days-per-year 365.24 ; inline
TUPLE: body TUPLE: body

View File

@ -113,7 +113,7 @@ MACRO: printf ( format-string -- )
<PRIVATE <PRIVATE
: zero-pad 2 CHAR: 0 pad-left ; inline : zero-pad ( str -- str' ) 2 CHAR: 0 pad-left ; inline
: >time ( timestamp -- string ) : >time ( timestamp -- string )
[ hour>> ] [ minute>> ] [ second>> floor ] tri 3array [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array

View File

@ -53,7 +53,7 @@ IN: iokit.hid
: kIOHIDElementDuplicateIndexKey "DuplicateIndex" ; inline : kIOHIDElementDuplicateIndexKey "DuplicateIndex" ; inline
: kIOHIDElementParentCollectionKey "ParentCollection" ; inline : kIOHIDElementParentCollectionKey "ParentCollection" ; inline
: kIOHIDElementVendorSpecificKey : kIOHIDElementVendorSpecificKey ( -- str )
cpu ppc? "VendorSpecifc" "VendorSpecific" ? ; inline cpu ppc? "VendorSpecifc" "VendorSpecific" ? ; inline
: kIOHIDElementCookieMinKey "ElementCookieMin" ; inline : kIOHIDElementCookieMinKey "ElementCookieMin" ; inline

View File

@ -3,5 +3,5 @@
USING: math math.constants ; USING: math math.constants ;
IN: math.trig IN: math.trig
: deg>rad pi * 180 / ; inline : deg>rad ( x -- y ) pi * 180 / ; inline
: rad>deg 180 * pi / ; inline : rad>deg ( x -- y ) 180 * pi / ; inline

View File

@ -25,6 +25,7 @@ M: tetris-gadget draw-gadget* ( gadget -- )
[ <new-tetris> ] change-tetris ; [ <new-tetris> ] change-tetris ;
tetris-gadget H{ tetris-gadget H{
{ T{ button-down f f 1 } [ request-focus ] }
{ T{ key-down f f "UP" } [ tetris>> rotate-right ] } { T{ key-down f f "UP" } [ tetris>> rotate-right ] }
{ T{ key-down f f "d" } [ tetris>> rotate-left ] } { T{ key-down f f "d" } [ tetris>> rotate-left ] }
{ T{ key-down f f "f" } [ tetris>> rotate-right ] } { T{ key-down f f "f" } [ tetris>> rotate-right ] }

View File

@ -47,13 +47,13 @@ TUPLE: packet link id kind a1 a2 ;
: HOLDBIT 4 ; inline : HOLDBIT 4 ; inline
: S_RUN 0 ; inline : S_RUN 0 ; inline
: S_RUNPKT { PKTBIT } flags ; inline : S_RUNPKT ( -- n ) { PKTBIT } flags ; inline
: S_WAIT { WAITBIT } flags ; inline : S_WAIT ( -- n ) { WAITBIT } flags ; inline
: S_WAITPKT { WAITBIT PKTBIT } flags ; inline : S_WAITPKT ( -- n ) { WAITBIT PKTBIT } flags ; inline
: S_HOLD { HOLDBIT } flags ; inline : S_HOLD ( -- n ) { HOLDBIT } flags ; inline
: S_HOLDPKT { HOLDBIT PKTBIT } flags ; inline : S_HOLDPKT ( -- n ) { HOLDBIT PKTBIT } flags ; inline
: S_HOLDWAIT { HOLDBIT WAITBIT } flags ; inline : S_HOLDWAIT ( -- n ) { HOLDBIT WAITBIT } flags ; inline
: S_HOLDWAITPKT { HOLDBIT WAITBIT PKTBIT } flags ; inline : S_HOLDWAITPKT ( -- n ) { HOLDBIT WAITBIT PKTBIT } flags ; inline
: task-tab-size 10 ; inline : task-tab-size 10 ; inline