Updating code to use CONSTANT: instead of : foo 123 ; inline
Slava Pestov
parent
f1d20719b2
commit
eaad0c7660
|
|
@ -4,7 +4,7 @@ USING: http.client checksums checksums.md5 splitting assocs
|
|||
kernel io.files bootstrap.image sequences io urls ;
|
||||
IN: bootstrap.image.download
|
||||
|
||||
: url URL" http://factorcode.org/images/latest/" ;
|
||||
CONSTANT: url URL" http://factorcode.org/images/latest/"
|
||||
|
||||
: download-checksums ( -- alist )
|
||||
url "checksums.txt" >url derive-url http-get nip
|
||||
|
|
|
|||
|
|
@ -72,9 +72,9 @@ C-ENUM:
|
|||
CAIRO_STATUS_INVALID_STRIDE ;
|
||||
|
||||
TYPEDEF: int cairo_content_t
|
||||
: CAIRO_CONTENT_COLOR HEX: 1000 ;
|
||||
: CAIRO_CONTENT_ALPHA HEX: 2000 ;
|
||||
: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 ;
|
||||
CONSTANT: CAIRO_CONTENT_COLOR HEX: 1000
|
||||
CONSTANT: CAIRO_CONTENT_ALPHA HEX: 2000
|
||||
CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000
|
||||
|
||||
TYPEDEF: void* cairo_write_func_t
|
||||
: cairo-write-func ( quot -- callback )
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@ stand-alone
|
|||
= (line | code | heading | list | table | paragraph | nl)*
|
||||
;EBNF
|
||||
|
||||
: invalid-url "javascript:alert('Invalid URL in farkup');" ;
|
||||
CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
|
||||
|
||||
: check-url ( href -- href' )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ TUPLE: action rest init authorize display validate submit ;
|
|||
: param ( name -- value )
|
||||
params get at ;
|
||||
|
||||
: revalidate-url-key "__u" ;
|
||||
CONSTANT: revalidate-url-key "__u"
|
||||
|
||||
: revalidate-url ( -- url/f )
|
||||
revalidate-url-key param
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ furnace.auth.providers
|
|||
furnace.auth.login.permits ;
|
||||
IN: furnace.alloy
|
||||
|
||||
: state-classes { session aside conversation permit } ; inline
|
||||
CONSTANT: state-classes { session aside conversation permit }
|
||||
|
||||
: init-furnace-tables ( -- )
|
||||
state-classes ensure-tables
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ aside "ASIDES" {
|
|||
{ "post-data" "POST_DATA" FACTOR-BLOB }
|
||||
} define-persistent
|
||||
|
||||
: aside-id-key "__a" ;
|
||||
CONSTANT: aside-id-key "__a"
|
||||
|
||||
TUPLE: asides < server-state-manager ;
|
||||
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ SYMBOL: capabilities
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: flashed-variables { description capabilities } ;
|
||||
CONSTANT: flashed-variables { description capabilities }
|
||||
|
||||
: login-failed ( -- * )
|
||||
"invalid username or password" validation-error
|
||||
|
|
|
|||
|
|
@ -3,9 +3,7 @@
|
|||
USING: furnace.auth.providers kernel ;
|
||||
IN: furnace.auth.providers.null
|
||||
|
||||
TUPLE: no-users ;
|
||||
|
||||
: no-users T{ no-users } ;
|
||||
SINGLETON: no-users
|
||||
|
||||
M: no-users get-user 2drop f ;
|
||||
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ conversation "CONVERSATIONS" {
|
|||
{ "session" "SESSION" BIG-INTEGER +not-null+ }
|
||||
} define-persistent
|
||||
|
||||
: conversation-id-key "__c" ;
|
||||
CONSTANT: conversation-id-key "__c"
|
||||
|
||||
TUPLE: conversations < server-state-manager ;
|
||||
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ TUPLE: sessions < server-state-manager domain verify? ;
|
|||
[ session set ] [ save-session-after ] bi
|
||||
sessions get responder>> call-responder ;
|
||||
|
||||
: session-id-key "__s" ;
|
||||
CONSTANT: session-id-key "__s"
|
||||
|
||||
: verify-session ( session -- session )
|
||||
sessions get verify?>> [
|
||||
|
|
|
|||
|
|
@ -89,7 +89,7 @@ M: object modify-form drop f ;
|
|||
[XML <input type="hidden" value=<-> name=<->/> XML]
|
||||
] [ drop ] if ;
|
||||
|
||||
: nested-forms-key "__n" ;
|
||||
CONSTANT: nested-forms-key "__n"
|
||||
|
||||
: request-params ( request -- assoc )
|
||||
dup method>> {
|
||||
|
|
@ -131,7 +131,7 @@ M: object modify-form drop f ;
|
|||
|
||||
SYMBOL: exit-continuation
|
||||
|
||||
: exit-with ( value -- )
|
||||
: exit-with ( value -- * )
|
||||
exit-continuation get continue-with ;
|
||||
|
||||
: with-exit-continuation ( quot -- value )
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ tags [ H{ } clone ] initialize
|
|||
: CHLOE:
|
||||
scan parse-definition define-chloe-tag ; parsing
|
||||
|
||||
: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
|
||||
CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0"
|
||||
|
||||
: chloe-name? ( name -- ? )
|
||||
url>> chloe-ns = ;
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@ USING: math.parser arrays io.encodings sequences kernel assocs
|
|||
hashtables io.encodings.ascii generic parser classes.tuple words
|
||||
words.symbol io io.files splitting namespaces math
|
||||
compiler.units accessors classes.singleton classes.mixin
|
||||
io.encodings.iana ;
|
||||
io.encodings.iana fry ;
|
||||
IN: io.encodings.8-bit
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: mappings {
|
||||
CONSTANT: mappings {
|
||||
! encoding-name iana-name file-name
|
||||
{ "latin1" "ISO_8859-1:1987" "8859-1" }
|
||||
{ "latin2" "ISO_8859-2:1987" "8859-2" }
|
||||
|
|
@ -30,11 +30,10 @@ IN: io.encodings.8-bit
|
|||
{ "windows-1252" "windows-1252" "CP1252" }
|
||||
{ "ebcdic" "IBM037" "CP037" }
|
||||
{ "mac-roman" "macintosh" "ROMAN" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: encoding-file ( file-name -- stream )
|
||||
"vocab:io/encodings/8-bit/" swap ".TXT"
|
||||
3append ;
|
||||
"vocab:io/encodings/8-bit/" ".TXT" surround ;
|
||||
|
||||
: process-contents ( lines -- assoc )
|
||||
[ "#" split1 drop ] map harvest
|
||||
|
|
@ -42,7 +41,7 @@ IN: io.encodings.8-bit
|
|||
|
||||
: byte>ch ( assoc -- array )
|
||||
256 replacement-char <array>
|
||||
[ [ swapd set-nth ] curry assoc-each ] keep ;
|
||||
[ '[ swap _ set-nth ] assoc-each ] keep ;
|
||||
|
||||
: ch>byte ( assoc -- newassoc )
|
||||
[ swap ] assoc-map >hashtable ;
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ SYMBOL: log-files
|
|||
dup values [ try-dispose ] each
|
||||
clear-assoc ;
|
||||
|
||||
: keep-logs 10 ;
|
||||
CONSTANT: keep-logs 10
|
||||
|
||||
: ?delete-file ( path -- )
|
||||
dup exists? [ delete-file ] [ drop ] if ;
|
||||
|
|
|
|||
|
|
@ -45,13 +45,13 @@ PRIVATE>
|
|||
first2 [ imaginary-part ] dip >rect 3array ;
|
||||
|
||||
! Zero
|
||||
: q0 { 0 0 } ;
|
||||
CONSTANT: q0 { 0 0 }
|
||||
|
||||
! Units
|
||||
: q1 { 1 0 } ;
|
||||
: qi { C{ 0 1 } 0 } ;
|
||||
: qj { 0 1 } ;
|
||||
: qk { 0 C{ 0 1 } } ;
|
||||
CONSTANT: q1 { 1 0 }
|
||||
CONSTANT: qi { C{ 0 1 } 0 }
|
||||
CONSTANT: qj { 0 1 }
|
||||
CONSTANT: qk { 0 C{ 0 1 } }
|
||||
|
||||
! Euler angles
|
||||
|
||||
|
|
|
|||
|
|
@ -993,8 +993,8 @@ FUNCTION: BOOL DuplicateHandle (
|
|||
BOOL bInheritHandle,
|
||||
DWORD dwOptions ) ;
|
||||
|
||||
: DUPLICATE_CLOSE_SOURCE 1 ;
|
||||
: DUPLICATE_SAME_ACCESS 2 ;
|
||||
CONSTANT: DUPLICATE_CLOSE_SOURCE 1
|
||||
CONSTANT: DUPLICATE_SAME_ACCESS 2
|
||||
|
||||
! FUNCTION: EncodePointer
|
||||
! FUNCTION: EncodeSystemPointer
|
||||
|
|
|
|||
|
|
@ -12,17 +12,17 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! Reserved Resource and Constant Definitions
|
||||
|
||||
: ParentRelative 1 ;
|
||||
: CopyFromParent 0 ;
|
||||
: PointerWindow 0 ;
|
||||
: InputFocus 1 ;
|
||||
: PointerRoot 1 ;
|
||||
: AnyPropertyType 0 ;
|
||||
: AnyKey 0 ;
|
||||
: AnyButton 0 ;
|
||||
: AllTemporary 0 ;
|
||||
: CurrentTime 0 ;
|
||||
: NoSymbol 0 ;
|
||||
CONSTANT: ParentRelative 1
|
||||
CONSTANT: CopyFromParent 0
|
||||
CONSTANT: PointerWindow 0
|
||||
CONSTANT: InputFocus 1
|
||||
CONSTANT: PointerRoot 1
|
||||
CONSTANT: AnyPropertyType 0
|
||||
CONSTANT: AnyKey 0
|
||||
CONSTANT: AnyButton 0
|
||||
CONSTANT: AllTemporary 0
|
||||
CONSTANT: CurrentTime 0
|
||||
CONSTANT: NoSymbol 0
|
||||
|
||||
! Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer,
|
||||
! state in various key-, mouse-, and button-related events.
|
||||
|
|
@ -31,14 +31,14 @@ TYPEDEF: uchar KeyCode
|
|||
! modifier names. Used to build a SetModifierMapping request or
|
||||
! to read a GetModifierMapping request. These correspond to the
|
||||
! masks defined above.
|
||||
: ShiftMapIndex 0 ;
|
||||
: LockMapIndex 1 ;
|
||||
: ControlMapIndex 2 ;
|
||||
: Mod1MapIndex 3 ;
|
||||
: Mod2MapIndex 4 ;
|
||||
: Mod3MapIndex 5 ;
|
||||
: Mod4MapIndex 6 ;
|
||||
: Mod5MapIndex 7 ;
|
||||
CONSTANT: ShiftMapIndex 0
|
||||
CONSTANT: LockMapIndex 1
|
||||
CONSTANT: ControlMapIndex 2
|
||||
CONSTANT: Mod1MapIndex 3
|
||||
CONSTANT: Mod2MapIndex 4
|
||||
CONSTANT: Mod3MapIndex 5
|
||||
CONSTANT: Mod4MapIndex 6
|
||||
CONSTANT: Mod5MapIndex 7
|
||||
|
||||
|
||||
! button masks. Used in same manner as Key masks above. Not to be confused
|
||||
|
|
@ -53,100 +53,100 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! Notify modes
|
||||
|
||||
: NotifyNormal 0 ;
|
||||
: NotifyGrab 1 ;
|
||||
: NotifyUngrab 2 ;
|
||||
: NotifyWhileGrabbed 3 ;
|
||||
CONSTANT: NotifyNormal 0
|
||||
CONSTANT: NotifyGrab 1
|
||||
CONSTANT: NotifyUngrab 2
|
||||
CONSTANT: NotifyWhileGrabbed 3
|
||||
|
||||
: NotifyHint 1 ; ! for MotionNotify events
|
||||
CONSTANT: NotifyHint 1 ! for MotionNotify events
|
||||
|
||||
! Notify detail
|
||||
|
||||
: NotifyAncestor 0 ;
|
||||
: NotifyVirtual 1 ;
|
||||
: NotifyInferior 2 ;
|
||||
: NotifyNonlinear 3 ;
|
||||
: NotifyNonlinearVirtual 4 ;
|
||||
: NotifyPointer 5 ;
|
||||
: NotifyPointerRoot 6 ;
|
||||
: NotifyDetailNone 7 ;
|
||||
CONSTANT: NotifyAncestor 0
|
||||
CONSTANT: NotifyVirtual 1
|
||||
CONSTANT: NotifyInferior 2
|
||||
CONSTANT: NotifyNonlinear 3
|
||||
CONSTANT: NotifyNonlinearVirtual 4
|
||||
CONSTANT: NotifyPointer 5
|
||||
CONSTANT: NotifyPointerRoot 6
|
||||
CONSTANT: NotifyDetailNone 7
|
||||
|
||||
! Visibility notify
|
||||
|
||||
: VisibilityUnobscured 0 ;
|
||||
: VisibilityPartiallyObscured 1 ;
|
||||
: VisibilityFullyObscured 2 ;
|
||||
CONSTANT: VisibilityUnobscured 0
|
||||
CONSTANT: VisibilityPartiallyObscured 1
|
||||
CONSTANT: VisibilityFullyObscured 2
|
||||
|
||||
! Circulation request
|
||||
|
||||
: PlaceOnTop 0 ;
|
||||
: PlaceOnBottom 1 ;
|
||||
CONSTANT: PlaceOnTop 0
|
||||
CONSTANT: PlaceOnBottom 1
|
||||
|
||||
! protocol families
|
||||
|
||||
: FamilyInternet 0 ; ! IPv4
|
||||
: FamilyDECnet 1 ;
|
||||
: FamilyChaos 2 ;
|
||||
: FamilyInternet6 6 ; ! IPv6
|
||||
CONSTANT: FamilyInternet 0 ! IPv4
|
||||
CONSTANT: FamilyDECnet 1
|
||||
CONSTANT: FamilyChaos 2
|
||||
CONSTANT: FamilyInternet6 6 ! IPv6
|
||||
|
||||
! authentication families not tied to a specific protocol
|
||||
: FamilyServerInterpreted 5 ;
|
||||
CONSTANT: FamilyServerInterpreted 5
|
||||
|
||||
! Property notification
|
||||
|
||||
: PropertyNewValue 0 ;
|
||||
: PropertyDelete 1 ;
|
||||
CONSTANT: PropertyNewValue 0
|
||||
CONSTANT: PropertyDelete 1
|
||||
|
||||
! Color Map notification
|
||||
|
||||
: ColormapUninstalled 0 ;
|
||||
: ColormapInstalled 1 ;
|
||||
CONSTANT: ColormapUninstalled 0
|
||||
CONSTANT: ColormapInstalled 1
|
||||
|
||||
! GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes
|
||||
|
||||
: GrabModeSync 0 ;
|
||||
: GrabModeAsync 1 ;
|
||||
CONSTANT: GrabModeSync 0
|
||||
CONSTANT: GrabModeAsync 1
|
||||
|
||||
! GrabPointer, GrabKeyboard reply status
|
||||
|
||||
: GrabSuccess 0 ;
|
||||
: AlreadyGrabbed 1 ;
|
||||
: GrabInvalidTime 2 ;
|
||||
: GrabNotViewable 3 ;
|
||||
: GrabFrozen 4 ;
|
||||
CONSTANT: GrabSuccess 0
|
||||
CONSTANT: AlreadyGrabbed 1
|
||||
CONSTANT: GrabInvalidTime 2
|
||||
CONSTANT: GrabNotViewable 3
|
||||
CONSTANT: GrabFrozen 4
|
||||
|
||||
! AllowEvents modes
|
||||
|
||||
: AsyncPointer 0 ;
|
||||
: SyncPointer 1 ;
|
||||
: ReplayPointer 2 ;
|
||||
: AsyncKeyboard 3 ;
|
||||
: SyncKeyboard 4 ;
|
||||
: ReplayKeyboard 5 ;
|
||||
: AsyncBoth 6 ;
|
||||
: SyncBoth 7 ;
|
||||
CONSTANT: AsyncPointer 0
|
||||
CONSTANT: SyncPointer 1
|
||||
CONSTANT: ReplayPointer 2
|
||||
CONSTANT: AsyncKeyboard 3
|
||||
CONSTANT: SyncKeyboard 4
|
||||
CONSTANT: ReplayKeyboard 5
|
||||
CONSTANT: AsyncBoth 6
|
||||
CONSTANT: SyncBoth 7
|
||||
|
||||
! Used in SetInputFocus, GetInputFocus
|
||||
|
||||
: RevertToNone ( -- n ) None ;
|
||||
: RevertToPointerRoot ( -- n ) PointerRoot ;
|
||||
: RevertToParent 2 ;
|
||||
CONSTANT: RevertToParent 2
|
||||
|
||||
! *****************************************************************
|
||||
! * ERROR CODES
|
||||
! *****************************************************************
|
||||
|
||||
: Success 0 ; ! everything's okay
|
||||
: BadRequest 1 ; ! bad request code
|
||||
: BadValue 2 ; ! int parameter out of range
|
||||
: BadWindow 3 ; ! parameter not a Window
|
||||
: BadPixmap 4 ; ! parameter not a Pixmap
|
||||
: BadAtom 5 ; ! parameter not an Atom
|
||||
: BadCursor 6 ; ! parameter not a Cursor
|
||||
: BadFont 7 ; ! parameter not a Font
|
||||
: BadMatch 8 ; ! parameter mismatch
|
||||
: BadDrawable 9 ; ! parameter not a Pixmap or Window
|
||||
: BadAccess 10 ; ! depending on context:
|
||||
CONSTANT: Success 0 ! everything's okay
|
||||
CONSTANT: BadRequest 1 ! bad request code
|
||||
CONSTANT: BadValue 2 ! int parameter out of range
|
||||
CONSTANT: BadWindow 3 ! parameter not a Window
|
||||
CONSTANT: BadPixmap 4 ! parameter not a Pixmap
|
||||
CONSTANT: BadAtom 5 ! parameter not an Atom
|
||||
CONSTANT: BadCursor 6 ! parameter not a Cursor
|
||||
CONSTANT: BadFont 7 ! parameter not a Font
|
||||
CONSTANT: BadMatch 8 ! parameter mismatch
|
||||
CONSTANT: BadDrawable 9 ! parameter not a Pixmap or Window
|
||||
CONSTANT: BadAccess 10 ! depending on context:
|
||||
! - key/button already grabbed
|
||||
! - attempt to free an illegal
|
||||
! cmap entry
|
||||
|
|
@ -154,16 +154,16 @@ TYPEDEF: uchar KeyCode
|
|||
! color map entry.
|
||||
! - attempt to modify the access control
|
||||
! list from other than the local host.
|
||||
: BadAlloc 11 ; ! insufficient resources
|
||||
: BadColor 12 ; ! no such colormap
|
||||
: BadGC 13 ; ! parameter not a GC
|
||||
: BadIDChoice 14 ; ! choice not in range or already used
|
||||
: BadName 15 ; ! font or color name doesn't exist
|
||||
: BadLength 16 ; ! Request length incorrect
|
||||
: BadImplementation 17 ; ! server is defective
|
||||
CONSTANT: BadAlloc 11 ! insufficient resources
|
||||
CONSTANT: BadColor 12 ! no such colormap
|
||||
CONSTANT: BadGC 13 ! parameter not a GC
|
||||
CONSTANT: BadIDChoice 14 ! choice not in range or already used
|
||||
CONSTANT: BadName 15 ! font or color name doesn't exist
|
||||
CONSTANT: BadLength 16 ! Request length incorrect
|
||||
CONSTANT: BadImplementation 17 ! server is defective
|
||||
|
||||
: FirstExtensionError 128 ;
|
||||
: LastExtensionError 255 ;
|
||||
CONSTANT: FirstExtensionError 128
|
||||
CONSTANT: LastExtensionError 255
|
||||
|
||||
! *****************************************************************
|
||||
! * WINDOW DEFINITIONS
|
||||
|
|
@ -172,44 +172,44 @@ TYPEDEF: uchar KeyCode
|
|||
! Window classes used by CreateWindow
|
||||
! Note that CopyFromParent is already defined as 0 above
|
||||
|
||||
: InputOutput 1 ;
|
||||
: InputOnly 2 ;
|
||||
CONSTANT: InputOutput 1
|
||||
CONSTANT: InputOnly 2
|
||||
|
||||
! Used in CreateWindow for backing-store hint
|
||||
|
||||
: NotUseful 0 ;
|
||||
: WhenMapped 1 ;
|
||||
: Always 2 ;
|
||||
CONSTANT: NotUseful 0
|
||||
CONSTANT: WhenMapped 1
|
||||
CONSTANT: Always 2
|
||||
|
||||
! Used in ChangeSaveSet
|
||||
|
||||
: SetModeInsert 0 ;
|
||||
: SetModeDelete 1 ;
|
||||
CONSTANT: SetModeInsert 0
|
||||
CONSTANT: SetModeDelete 1
|
||||
|
||||
! Used in ChangeCloseDownMode
|
||||
|
||||
: DestroyAll 0 ;
|
||||
: RetainPermanent 1 ;
|
||||
: RetainTemporary 2 ;
|
||||
CONSTANT: DestroyAll 0
|
||||
CONSTANT: RetainPermanent 1
|
||||
CONSTANT: RetainTemporary 2
|
||||
|
||||
! Window stacking method (in configureWindow)
|
||||
|
||||
: Above 0 ;
|
||||
: Below 1 ;
|
||||
: TopIf 2 ;
|
||||
: BottomIf 3 ;
|
||||
: Opposite 4 ;
|
||||
CONSTANT: Above 0
|
||||
CONSTANT: Below 1
|
||||
CONSTANT: TopIf 2
|
||||
CONSTANT: BottomIf 3
|
||||
CONSTANT: Opposite 4
|
||||
|
||||
! Circulation direction
|
||||
|
||||
: RaiseLowest 0 ;
|
||||
: LowerHighest 1 ;
|
||||
CONSTANT: RaiseLowest 0
|
||||
CONSTANT: LowerHighest 1
|
||||
|
||||
! Property modes
|
||||
|
||||
: PropModeReplace 0 ;
|
||||
: PropModePrepend 1 ;
|
||||
: PropModeAppend 2 ;
|
||||
CONSTANT: PropModeReplace 0
|
||||
CONSTANT: PropModePrepend 1
|
||||
CONSTANT: PropModeAppend 2
|
||||
|
||||
! *****************************************************************
|
||||
! * GRAPHICS DEFINITIONS
|
||||
|
|
@ -217,62 +217,62 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! LineStyle
|
||||
|
||||
: LineSolid 0 ;
|
||||
: LineOnOffDash 1 ;
|
||||
: LineDoubleDash 2 ;
|
||||
CONSTANT: LineSolid 0
|
||||
CONSTANT: LineOnOffDash 1
|
||||
CONSTANT: LineDoubleDash 2
|
||||
|
||||
! capStyle
|
||||
|
||||
: CapNotLast 0 ;
|
||||
: CapButt 1 ;
|
||||
: CapRound 2 ;
|
||||
: CapProjecting 3 ;
|
||||
CONSTANT: CapNotLast 0
|
||||
CONSTANT: CapButt 1
|
||||
CONSTANT: CapRound 2
|
||||
CONSTANT: CapProjecting 3
|
||||
|
||||
! joinStyle
|
||||
|
||||
: JoinMiter 0 ;
|
||||
: JoinRound 1 ;
|
||||
: JoinBevel 2 ;
|
||||
CONSTANT: JoinMiter 0
|
||||
CONSTANT: JoinRound 1
|
||||
CONSTANT: JoinBevel 2
|
||||
|
||||
! fillStyle
|
||||
|
||||
: FillSolid 0 ;
|
||||
: FillTiled 1 ;
|
||||
: FillStippled 2 ;
|
||||
: FillOpaqueStippled 3 ;
|
||||
CONSTANT: FillSolid 0
|
||||
CONSTANT: FillTiled 1
|
||||
CONSTANT: FillStippled 2
|
||||
CONSTANT: FillOpaqueStippled 3
|
||||
|
||||
! fillRule
|
||||
|
||||
: EvenOddRule 0 ;
|
||||
: WindingRule 1 ;
|
||||
CONSTANT: EvenOddRule 0
|
||||
CONSTANT: WindingRule 1
|
||||
|
||||
! subwindow mode
|
||||
|
||||
: ClipByChildren 0 ;
|
||||
: IncludeInferiors 1 ;
|
||||
CONSTANT: ClipByChildren 0
|
||||
CONSTANT: IncludeInferiors 1
|
||||
|
||||
! SetClipRectangles ordering
|
||||
|
||||
: Unsorted 0 ;
|
||||
: YSorted 1 ;
|
||||
: YXSorted 2 ;
|
||||
: YXBanded 3 ;
|
||||
CONSTANT: Unsorted 0
|
||||
CONSTANT: YSorted 1
|
||||
CONSTANT: YXSorted 2
|
||||
CONSTANT: YXBanded 3
|
||||
|
||||
! CoordinateMode for drawing routines
|
||||
|
||||
: CoordModeOrigin 0 ; ! relative to the origin
|
||||
: CoordModePrevious 1 ; ! relative to previous point
|
||||
CONSTANT: CoordModeOrigin 0 ! relative to the origin
|
||||
CONSTANT: CoordModePrevious 1 ! relative to previous point
|
||||
|
||||
! Polygon shapes
|
||||
|
||||
: Complex 0 ; ! paths may intersect
|
||||
: Nonconvex 1 ; ! no paths intersect, but not convex
|
||||
: Convex 2 ; ! wholly convex
|
||||
CONSTANT: Complex 0 ! paths may intersect
|
||||
CONSTANT: Nonconvex 1 ! no paths intersect, but not convex
|
||||
CONSTANT: Convex 2 ! wholly convex
|
||||
|
||||
! Arc modes for PolyFillArc
|
||||
|
||||
: ArcChord 0 ; ! join endpoints of arc
|
||||
: ArcPieSlice 1 ; ! join endpoints to center of arc
|
||||
CONSTANT: ArcChord 0 ! join endpoints of arc
|
||||
CONSTANT: ArcPieSlice 1 ! join endpoints to center of arc
|
||||
|
||||
! *****************************************************************
|
||||
! * FONTS
|
||||
|
|
@ -280,10 +280,10 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! used in QueryFont -- draw direction
|
||||
|
||||
: FontLeftToRight 0 ;
|
||||
: FontRightToLeft 1 ;
|
||||
CONSTANT: FontLeftToRight 0
|
||||
CONSTANT: FontRightToLeft 1
|
||||
|
||||
: FontChange 255 ;
|
||||
CONSTANT: FontChange 255
|
||||
|
||||
! *****************************************************************
|
||||
! * IMAGING
|
||||
|
|
@ -291,9 +291,9 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! ImageFormat -- PutImage, GetImage
|
||||
|
||||
: XYBitmap 0 ; ! depth 1, XYFormat
|
||||
: XYPixmap 1 ; ! depth == drawable depth
|
||||
: ZPixmap 2 ; ! depth == drawable depth
|
||||
CONSTANT: XYBitmap 0 ! depth 1, XYFormat
|
||||
CONSTANT: XYPixmap 1 ! depth == drawable depth
|
||||
CONSTANT: ZPixmap 2 ! depth == drawable depth
|
||||
|
||||
! *****************************************************************
|
||||
! * COLOR MAP STUFF
|
||||
|
|
@ -301,8 +301,8 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! For CreateColormap
|
||||
|
||||
: AllocNone 0 ; ! create map with no entries
|
||||
: AllocAll 1 ; ! allocate entire map writeable
|
||||
CONSTANT: AllocNone 0 ! create map with no entries
|
||||
CONSTANT: AllocAll 1 ! allocate entire map writeable
|
||||
|
||||
|
||||
! Flags used in StoreNamedColor, StoreColors
|
||||
|
|
@ -317,20 +317,20 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! QueryBestSize Class
|
||||
|
||||
: CursorShape 0 ; ! largest size that can be displayed
|
||||
: TileShape 1 ; ! size tiled fastest
|
||||
: StippleShape 2 ; ! size stippled fastest
|
||||
CONSTANT: CursorShape 0 ! largest size that can be displayed
|
||||
CONSTANT: TileShape 1 ! size tiled fastest
|
||||
CONSTANT: StippleShape 2 ! size stippled fastest
|
||||
|
||||
! *****************************************************************
|
||||
! * KEYBOARD/POINTER STUFF
|
||||
! *****************************************************************
|
||||
|
||||
: AutoRepeatModeOff 0 ;
|
||||
: AutoRepeatModeOn 1 ;
|
||||
: AutoRepeatModeDefault 2 ;
|
||||
CONSTANT: AutoRepeatModeOff 0
|
||||
CONSTANT: AutoRepeatModeOn 1
|
||||
CONSTANT: AutoRepeatModeDefault 2
|
||||
|
||||
: LedModeOff 0 ;
|
||||
: LedModeOn 1 ;
|
||||
CONSTANT: LedModeOff 0
|
||||
CONSTANT: LedModeOn 1
|
||||
|
||||
! masks for ChangeKeyboardControl
|
||||
|
||||
|
|
@ -343,33 +343,33 @@ TYPEDEF: uchar KeyCode
|
|||
: KBKey ( -- n ) 6 2^ ;
|
||||
: KBAutoRepeatMode ( -- n ) 7 2^ ;
|
||||
|
||||
: MappingSuccess 0 ;
|
||||
: MappingBusy 1 ;
|
||||
: MappingFailed 2 ;
|
||||
CONSTANT: MappingSuccess 0
|
||||
CONSTANT: MappingBusy 1
|
||||
CONSTANT: MappingFailed 2
|
||||
|
||||
: MappingModifier 0 ;
|
||||
: MappingKeyboard 1 ;
|
||||
: MappingPointer 2 ;
|
||||
CONSTANT: MappingModifier 0
|
||||
CONSTANT: MappingKeyboard 1
|
||||
CONSTANT: MappingPointer 2
|
||||
|
||||
! *****************************************************************
|
||||
! * SCREEN SAVER STUFF
|
||||
! *****************************************************************
|
||||
|
||||
: DontPreferBlanking 0 ;
|
||||
: PreferBlanking 1 ;
|
||||
: DefaultBlanking 2 ;
|
||||
CONSTANT: DontPreferBlanking 0
|
||||
CONSTANT: PreferBlanking 1
|
||||
CONSTANT: DefaultBlanking 2
|
||||
|
||||
: DisableScreenSaver 0 ;
|
||||
: DisableScreenInterval 0 ;
|
||||
CONSTANT: DisableScreenSaver 0
|
||||
CONSTANT: DisableScreenInterval 0
|
||||
|
||||
: DontAllowExposures 0 ;
|
||||
: AllowExposures 1 ;
|
||||
: DefaultExposures 2 ;
|
||||
CONSTANT: DontAllowExposures 0
|
||||
CONSTANT: AllowExposures 1
|
||||
CONSTANT: DefaultExposures 2
|
||||
|
||||
! for ForceScreenSaver
|
||||
|
||||
: ScreenSaverReset 0 ;
|
||||
: ScreenSaverActive 1 ;
|
||||
CONSTANT: ScreenSaverReset 0
|
||||
CONSTANT: ScreenSaverActive 1
|
||||
|
||||
! *****************************************************************
|
||||
! * HOSTS AND CONNECTIONS
|
||||
|
|
@ -377,30 +377,30 @@ TYPEDEF: uchar KeyCode
|
|||
|
||||
! for ChangeHosts
|
||||
|
||||
: HostInsert 0 ;
|
||||
: HostDelete 1 ;
|
||||
CONSTANT: HostInsert 0
|
||||
CONSTANT: HostDelete 1
|
||||
|
||||
! for ChangeAccessControl
|
||||
|
||||
: EnableAccess 1 ;
|
||||
: DisableAccess 0 ;
|
||||
CONSTANT: EnableAccess 1
|
||||
CONSTANT: DisableAccess 0
|
||||
|
||||
! Display classes used in opening the connection
|
||||
! Note that the statically allocated ones are even numbered and the
|
||||
! dynamically changeable ones are odd numbered
|
||||
|
||||
: StaticGray 0 ;
|
||||
: GrayScale 1 ;
|
||||
: StaticColor 2 ;
|
||||
: PseudoColor 3 ;
|
||||
: TrueColor 4 ;
|
||||
: DirectColor 5 ;
|
||||
CONSTANT: StaticGray 0
|
||||
CONSTANT: GrayScale 1
|
||||
CONSTANT: StaticColor 2
|
||||
CONSTANT: PseudoColor 3
|
||||
CONSTANT: TrueColor 4
|
||||
CONSTANT: DirectColor 5
|
||||
|
||||
|
||||
! Byte order used in imageByteOrder and bitmapBitOrder
|
||||
|
||||
: LSBFirst 0 ;
|
||||
: MSBFirst 1 ;
|
||||
CONSTANT: LSBFirst 0
|
||||
CONSTANT: MSBFirst 1
|
||||
|
||||
! *****************************************************************
|
||||
! * EXTENDED WINDOW MANAGER HINTS
|
||||
|
|
|
|||
|
|
@ -9,23 +9,23 @@ IN: x11.glx
|
|||
LIBRARY: glx
|
||||
|
||||
! Visual Config Attributes (glXGetConfig, glXGetFBConfigAttrib)
|
||||
: GLX_USE_GL 1 ; ! support GLX rendering
|
||||
: GLX_BUFFER_SIZE 2 ; ! depth of the color buffer
|
||||
: GLX_LEVEL 3 ; ! level in plane stacking
|
||||
: GLX_RGBA 4 ; ! true if RGBA mode
|
||||
: GLX_DOUBLEBUFFER 5 ; ! double buffering supported
|
||||
: GLX_STEREO 6 ; ! stereo buffering supported
|
||||
: GLX_AUX_BUFFERS 7 ; ! number of aux buffers
|
||||
: GLX_RED_SIZE 8 ; ! number of red component bits
|
||||
: GLX_GREEN_SIZE 9 ; ! number of green component bits
|
||||
: GLX_BLUE_SIZE 10 ; ! number of blue component bits
|
||||
: GLX_ALPHA_SIZE 11 ; ! number of alpha component bits
|
||||
: GLX_DEPTH_SIZE 12 ; ! number of depth bits
|
||||
: GLX_STENCIL_SIZE 13 ; ! number of stencil bits
|
||||
: GLX_ACCUM_RED_SIZE 14 ; ! number of red accum bits
|
||||
: GLX_ACCUM_GREEN_SIZE 15 ; ! number of green accum bits
|
||||
: GLX_ACCUM_BLUE_SIZE 16 ; ! number of blue accum bits
|
||||
: GLX_ACCUM_ALPHA_SIZE 17 ; ! number of alpha accum bits
|
||||
CONSTANT: GLX_USE_GL 1 ! support GLX rendering
|
||||
CONSTANT: GLX_BUFFER_SIZE 2 ! depth of the color buffer
|
||||
CONSTANT: GLX_LEVEL 3 ! level in plane stacking
|
||||
CONSTANT: GLX_RGBA 4 ! true if RGBA mode
|
||||
CONSTANT: GLX_DOUBLEBUFFER 5 ! double buffering supported
|
||||
CONSTANT: GLX_STEREO 6 ! stereo buffering supported
|
||||
CONSTANT: GLX_AUX_BUFFERS 7 ! number of aux buffers
|
||||
CONSTANT: GLX_RED_SIZE 8 ! number of red component bits
|
||||
CONSTANT: GLX_GREEN_SIZE 9 ! number of green component bits
|
||||
CONSTANT: GLX_BLUE_SIZE 10 ! number of blue component bits
|
||||
CONSTANT: GLX_ALPHA_SIZE 11 ! number of alpha component bits
|
||||
CONSTANT: GLX_DEPTH_SIZE 12 ! number of depth bits
|
||||
CONSTANT: GLX_STENCIL_SIZE 13 ! number of stencil bits
|
||||
CONSTANT: GLX_ACCUM_RED_SIZE 14 ! number of red accum bits
|
||||
CONSTANT: GLX_ACCUM_GREEN_SIZE 15 ! number of green accum bits
|
||||
CONSTANT: GLX_ACCUM_BLUE_SIZE 16 ! number of blue accum bits
|
||||
CONSTANT: GLX_ACCUM_ALPHA_SIZE 17 ! number of alpha accum bits
|
||||
|
||||
TYPEDEF: XID GLXContextID
|
||||
TYPEDEF: XID GLXPixmap
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ SYMBOL: xim
|
|||
XNResourceClass over 0 XCreateIC
|
||||
[ "XCreateIC() failed" throw ] unless* ;
|
||||
|
||||
: buf-size 100 ;
|
||||
CONSTANT: buf-size 100
|
||||
|
||||
SYMBOL: keybuf
|
||||
SYMBOL: keysym
|
||||
|
|
|
|||
|
|
@ -4,20 +4,20 @@ USING: namespaces make kernel assocs sequences fry values
|
|||
io.files io.encodings.binary xml.state ;
|
||||
IN: xml.entities
|
||||
|
||||
: entities-out
|
||||
CONSTANT: entities-out
|
||||
H{
|
||||
{ CHAR: < "<" }
|
||||
{ CHAR: > ">" }
|
||||
{ CHAR: & "&" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: quoted-entities-out
|
||||
CONSTANT: quoted-entities-out
|
||||
H{
|
||||
{ CHAR: & "&" }
|
||||
{ CHAR: ' "'" }
|
||||
{ CHAR: " """ }
|
||||
{ CHAR: < "<" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: escape-string-by ( str table -- escaped )
|
||||
#! Convert <, >, &, ' and " to HTML entities.
|
||||
|
|
@ -29,14 +29,14 @@ IN: xml.entities
|
|||
: escape-quoted-string ( str -- newstr )
|
||||
quoted-entities-out escape-string-by ;
|
||||
|
||||
: entities
|
||||
CONSTANT: entities
|
||||
H{
|
||||
{ "lt" CHAR: < }
|
||||
{ "gt" CHAR: > }
|
||||
{ "amp" CHAR: & }
|
||||
{ "apos" CHAR: ' }
|
||||
{ "quot" CHAR: " }
|
||||
} ;
|
||||
}
|
||||
|
||||
: with-entities ( entities quot -- )
|
||||
[ swap extra-entities set call ] with-scope ; inline
|
||||
|
|
|
|||
|
|
@ -290,7 +290,7 @@ M: quoteless-attr summary
|
|||
|
||||
TUPLE: attr-w/< < xml-error-at ;
|
||||
|
||||
: attr-w/< ( value -- * )
|
||||
: attr-w/< ( -- * )
|
||||
\ attr-w/< xml-error-at throw ;
|
||||
|
||||
M: attr-w/< summary
|
||||
|
|
@ -299,7 +299,7 @@ M: attr-w/< summary
|
|||
|
||||
TUPLE: text-w/]]> < xml-error-at ;
|
||||
|
||||
: text-w/]]> ( text -- * )
|
||||
: text-w/]]> ( -- * )
|
||||
\ text-w/]]> xml-error-at throw ;
|
||||
|
||||
M: text-w/]]> summary
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ arrays words quotations accessors math.parser backtrack assocs ;
|
|||
|
||||
IN: 24-game
|
||||
SYMBOL: commands
|
||||
: nop ;
|
||||
: nop ( -- ) ;
|
||||
: do-something ( a b -- c ) { + - * } amb-execute ;
|
||||
: maybe-swap ( a b -- a b ) { nop swap } amb-execute ;
|
||||
: some-rots ( a b c -- a b c )
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: benchmark.backtrack
|
|||
! placing them on the stack, and applying the operations
|
||||
! +, -, * and rot as many times as we wish.
|
||||
|
||||
: nop ;
|
||||
: nop ( -- ) ;
|
||||
|
||||
: do-something ( a b -- c )
|
||||
{ + - * } amb-execute ;
|
||||
|
|
@ -42,7 +42,7 @@ MEMO: 24-from-4 ( a b c d -- ? )
|
|||
] sigma
|
||||
] sigma ;
|
||||
|
||||
: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
|
||||
CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 }
|
||||
|
||||
: backtrack-benchmark ( -- )
|
||||
words [ reset-memoized ] each
|
||||
|
|
|
|||
|
|
@ -10,8 +10,6 @@ CONSTANT: IC 29573
|
|||
CONSTANT: initial-seed 42
|
||||
CONSTANT: line-length 60
|
||||
|
||||
USE: math.private
|
||||
|
||||
: random ( seed -- n seed )
|
||||
>float IA * IC + IM mod [ IM /f ] keep ; inline
|
||||
|
||||
|
|
@ -19,7 +17,7 @@ HINTS: random fixnum ;
|
|||
|
||||
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
|
||||
|
||||
: IUB
|
||||
CONSTANT: IUB
|
||||
{
|
||||
{ CHAR: a 0.27 }
|
||||
{ CHAR: c 0.12 }
|
||||
|
|
@ -37,15 +35,15 @@ CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACC
|
|||
{ CHAR: V 0.02 }
|
||||
{ CHAR: W 0.02 }
|
||||
{ CHAR: Y 0.02 }
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: homo-sapiens
|
||||
CONSTANT: homo-sapiens
|
||||
{
|
||||
{ CHAR: a 0.3029549426680 }
|
||||
{ CHAR: c 0.1979883004921 }
|
||||
{ CHAR: g 0.1975473066391 }
|
||||
{ CHAR: t 0.3015094502008 }
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: make-cumulative ( freq -- chars floats )
|
||||
dup keys >byte-array
|
||||
|
|
|
|||
|
|
@ -8,13 +8,14 @@ hints ;
|
|||
IN: benchmark.raytracer
|
||||
|
||||
! parameters
|
||||
: light
|
||||
#! Normalized { -1 -3 2 }.
|
||||
|
||||
! Normalized { -1 -3 2 }.
|
||||
CONSTANT: light
|
||||
double-array{
|
||||
-0.2672612419124244
|
||||
-0.8017837257372732
|
||||
0.5345224838248488
|
||||
} ; inline
|
||||
}
|
||||
|
||||
CONSTANT: oversampling 4
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ SYMBOL: counter
|
|||
SYMBOL: port-promise
|
||||
SYMBOL: server
|
||||
|
||||
: number-of-requests 1000 ;
|
||||
CONSTANT: number-of-requests 1000
|
||||
|
||||
: server-addr ( -- addr )
|
||||
"127.0.0.1" port-promise get ?promise <inet4> ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
|
|||
compiler.cfg.optimizer fry ;
|
||||
IN: galois-talk
|
||||
|
||||
: galois-slides
|
||||
CONSTANT: galois-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
|
|
@ -305,7 +305,7 @@ IN: galois-talk
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
} ;
|
||||
}
|
||||
|
||||
: galois-talk ( -- ) galois-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -121,12 +121,12 @@ CONSTANT: hat-switch-matching-hash
|
|||
: hat-switch? ( {usage-page,usage} -- ? )
|
||||
{ 1 HEX: 39 } = ; inline
|
||||
|
||||
: pov-values
|
||||
CONSTANT: pov-values
|
||||
{
|
||||
pov-up pov-up-right pov-right pov-down-right
|
||||
pov-down pov-down-left pov-left pov-up-left
|
||||
pov-neutral
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: button-value ( value -- f/(0,1] )
|
||||
IOHIDValueGetIntegerValue dup zero? [ drop f ] when ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
|
|||
compiler.cfg.optimizer fry ;
|
||||
IN: google-tech-talk
|
||||
|
||||
: google-slides
|
||||
CONSTANT: google-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
|
|
@ -562,7 +562,7 @@ IN: google-tech-talk
|
|||
"Put your prejudices aside and give it a shot!"
|
||||
}
|
||||
{ $slide "Questions?" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: google-talk ( -- ) google-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ IN: irc.client
|
|||
! Setup and running objects
|
||||
! ======================================
|
||||
|
||||
: irc-port 6667 ; ! Default irc port
|
||||
CONSTANT: irc-port 6667 ! Default irc port
|
||||
|
||||
TUPLE: irc-profile server port nickname password ;
|
||||
C: <irc-profile> irc-profile
|
||||
|
|
|
|||
|
|
@ -28,9 +28,9 @@ TUPLE: irc-tab < frame chat client window ;
|
|||
|
||||
: write-color ( str color -- )
|
||||
foreground associate format ;
|
||||
: dark-red T{ rgba f 0.5 0.0 0.0 1 } ;
|
||||
: dark-green T{ rgba f 0.0 0.5 0.0 1 } ;
|
||||
: dark-blue T{ rgba f 0.0 0.0 0.5 1 } ;
|
||||
CONSTANT: dark-red T{ rgba f 0.5 0.0 0.0 1 }
|
||||
CONSTANT: dark-green T{ rgba f 0.0 0.5 0.0 1 }
|
||||
CONSTANT: dark-blue T{ rgba f 0.0 0.0 0.5 1 }
|
||||
|
||||
: dot-or-parens ( string -- string )
|
||||
[ "." ]
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ calendar locals strings ui.gadgets.buttons
|
|||
combinators math.parser assocs threads ;
|
||||
IN: joystick-demo
|
||||
|
||||
: SIZE { 151 151 } ;
|
||||
: INDICATOR-SIZE { 4 4 } ;
|
||||
CONSTANT: SIZE { 151 151 }
|
||||
CONSTANT: INDICATOR-SIZE { 4 4 }
|
||||
: FREQUENCY ( -- f ) 30 recip seconds ;
|
||||
|
||||
TUPLE: axis-gadget < gadget indicator z-indicator pov ;
|
||||
|
|
@ -21,7 +21,7 @@ M: axis-gadget pref-dim* drop SIZE ;
|
|||
: indicator-polygon ( -- polygon )
|
||||
{ 0 0 } INDICATOR-SIZE (rect-polygon) ;
|
||||
|
||||
: pov-polygons
|
||||
CONSTANT: pov-polygons
|
||||
V{
|
||||
{ pov-neutral { { 70 75 } { 75 70 } { 80 75 } { 75 80 } } }
|
||||
{ pov-up { { 70 65 } { 75 60 } { 80 65 } } }
|
||||
|
|
@ -32,7 +32,7 @@ M: axis-gadget pref-dim* drop SIZE ;
|
|||
{ pov-down-left { { 67 90 } { 60 90 } { 60 83 } } }
|
||||
{ pov-left { { 65 70 } { 60 75 } { 65 80 } } }
|
||||
{ pov-up-left { { 67 60 } { 60 60 } { 60 67 } } }
|
||||
} ;
|
||||
}
|
||||
|
||||
: <indicator-gadget> ( color -- indicator )
|
||||
indicator-polygon <polygon-gadget> ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ words arrays assocs math calendar fry alarms ui
|
|||
ui.gadgets.borders ui.gestures ;
|
||||
IN: key-caps
|
||||
|
||||
: key-locations H{
|
||||
CONSTANT: key-locations H{
|
||||
{ key-escape { { 0 0 } { 10 10 } } }
|
||||
|
||||
{ key-f1 { { 20 0 } { 10 10 } } }
|
||||
|
|
@ -129,9 +129,9 @@ IN: key-caps
|
|||
|
||||
{ key-keypad-0 { { 190 55 } { 20 10 } } }
|
||||
{ key-keypad-. { { 210 55 } { 10 10 } } }
|
||||
} ;
|
||||
}
|
||||
|
||||
: KEYBOARD-SIZE { 230 65 } ;
|
||||
CONSTANT: KEYBOARD-SIZE { 230 65 }
|
||||
: FREQUENCY ( -- f ) 30 recip seconds ;
|
||||
|
||||
TUPLE: key-caps-gadget < gadget keys alarm ;
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ SYMBOL: def-hash-keys
|
|||
set-alien-float alien-float
|
||||
} ;
|
||||
|
||||
: trivial-defs
|
||||
: trivial-defs ( -- seq )
|
||||
{
|
||||
[ drop ] [ 2array ]
|
||||
[ bitand ]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: arrays kernel xml-rpc ;
|
||||
IN: lisppaste
|
||||
|
||||
: url "http://www.common-lisp.net:8185/RPC2" ;
|
||||
CONSTANT: url "http://www.common-lisp.net:8185/RPC2"
|
||||
|
||||
: channels ( -- seq )
|
||||
{ } "listchannels" url invoke-method ;
|
||||
|
|
|
|||
|
|
@ -67,24 +67,24 @@ SYMBOL: stamp
|
|||
: ?prepare-build-machine ( -- )
|
||||
builds/factor exists? [ prepare-build-machine ] unless ;
|
||||
|
||||
: load-everything-vocabs-file "load-everything-vocabs" ;
|
||||
: load-everything-errors-file "load-everything-errors" ;
|
||||
CONSTANT: load-everything-vocabs-file "load-everything-vocabs"
|
||||
CONSTANT: load-everything-errors-file "load-everything-errors"
|
||||
|
||||
: test-all-vocabs-file "test-all-vocabs" ;
|
||||
: test-all-errors-file "test-all-errors" ;
|
||||
CONSTANT: test-all-vocabs-file "test-all-vocabs"
|
||||
CONSTANT: test-all-errors-file "test-all-errors"
|
||||
|
||||
: help-lint-vocabs-file "help-lint-vocabs" ;
|
||||
: help-lint-errors-file "help-lint-errors" ;
|
||||
CONSTANT: help-lint-vocabs-file "help-lint-vocabs"
|
||||
CONSTANT: help-lint-errors-file "help-lint-errors"
|
||||
|
||||
: boot-time-file "boot-time" ;
|
||||
: load-time-file "load-time" ;
|
||||
: compiler-errors-file "compiler-errors" ;
|
||||
: test-time-file "test-time" ;
|
||||
: help-lint-time-file "help-lint-time" ;
|
||||
: benchmark-time-file "benchmark-time" ;
|
||||
: html-help-time-file "html-help-time" ;
|
||||
CONSTANT: boot-time-file "boot-time"
|
||||
CONSTANT: load-time-file "load-time"
|
||||
CONSTANT: compiler-errors-file "compiler-errors"
|
||||
CONSTANT: test-time-file "test-time"
|
||||
CONSTANT: help-lint-time-file "help-lint-time"
|
||||
CONSTANT: benchmark-time-file "benchmark-time"
|
||||
CONSTANT: html-help-time-file "html-help-time"
|
||||
|
||||
: benchmarks-file "benchmarks" ;
|
||||
CONSTANT: benchmarks-file "benchmarks"
|
||||
|
||||
SYMBOL: status
|
||||
|
||||
|
|
|
|||
|
|
@ -11,11 +11,11 @@ IN: math.analysis
|
|||
|
||||
CONSTANT: gamma-g6 5.15
|
||||
|
||||
: gamma-p6
|
||||
CONSTANT: gamma-p6
|
||||
{
|
||||
2.50662827563479526904 225.525584619175212544 -268.295973841304927459
|
||||
80.9030806934622512966 -5.00757863970517583837 0.0114684895434781459556
|
||||
} ; inline
|
||||
}
|
||||
|
||||
: gamma-z ( x n -- seq )
|
||||
[ + recip ] with map 1.0 0 pick set-nth ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
|
|||
math.order math.geometry.rect ;
|
||||
IN: maze
|
||||
|
||||
: line-width 8 ;
|
||||
CONSTANT: line-width 8
|
||||
|
||||
SYMBOL: visited
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: slides help.markup math arrays hashtables namespaces
|
|||
sequences kernel sequences parser memoize ;
|
||||
IN: minneapolis-talk
|
||||
|
||||
: minneapolis-slides
|
||||
CONSTANT: minneapolis-slides
|
||||
{
|
||||
{ $slide "What is Factor?"
|
||||
"Dynamically typed, stack language"
|
||||
|
|
@ -175,7 +175,7 @@ IN: minneapolis-talk
|
|||
"Mailing list: factor-talk@lists.sf.net"
|
||||
}
|
||||
{ $slide "Questions?" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: minneapolis-talk ( -- ) minneapolis-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,116 +0,0 @@
|
|||
- how to create a small module
|
||||
- editor integration
|
||||
- presentations
|
||||
- module system
|
||||
- copy and paste factoring, inverse
|
||||
- help system
|
||||
- tetris
|
||||
- memoization
|
||||
- editing inspector demo
|
||||
- dynamic scope, lexical scope
|
||||
|
||||
Factor: contradictions?
|
||||
-----------------------
|
||||
|
||||
Have our cake and eat it too
|
||||
|
||||
Research -vs- practical
|
||||
High level -vs- fast
|
||||
Interactive -vs- deployment
|
||||
|
||||
Factor from 10,000 feet
|
||||
-----------------------
|
||||
|
||||
word: named function
|
||||
vocabulary: module
|
||||
quotation: anonymous function
|
||||
classes, objects, etc.
|
||||
|
||||
The stack
|
||||
---------
|
||||
|
||||
- Stack -vs- applicative
|
||||
- Pass by reference, dynamically typed
|
||||
- Stack languages: you can omit names where they're not needed
|
||||
- More compositional style
|
||||
- If you need to name things for clarity, you can:
|
||||
lexical vars, dynamic vars, sequences, assocs, objects...
|
||||
|
||||
Functional programming
|
||||
----------------------
|
||||
|
||||
Quotations
|
||||
Curry
|
||||
Continuations
|
||||
|
||||
Object-oriented programming
|
||||
---------------------------
|
||||
|
||||
Generic words: sort of like open classes
|
||||
Tuple reshaping
|
||||
Editing inspector
|
||||
|
||||
Meta programming
|
||||
----------------
|
||||
|
||||
Simple, orthogonal core
|
||||
|
||||
Why use a stack at all?
|
||||
-----------------------
|
||||
|
||||
Nice idioms: 10 days ago
|
||||
Copy and paste factoring
|
||||
Easy meta-programming
|
||||
Sequence operations correspond to functional operations:
|
||||
- curry is adding at the front
|
||||
- compose is append
|
||||
|
||||
UI
|
||||
--
|
||||
|
||||
Written in Factor
|
||||
renders with OpenGL
|
||||
Windows, X11, Cocoa backends
|
||||
You can call Windows, X11, Cocoa APIs directly
|
||||
OpenGL 2.1 shaders, OpenAL 3D audio...
|
||||
|
||||
Tools
|
||||
-----
|
||||
|
||||
Edit
|
||||
Usages
|
||||
Profiler
|
||||
Easy to make your own tools
|
||||
|
||||
Implementation
|
||||
--------------
|
||||
|
||||
Two compilers
|
||||
Generational garbage collector
|
||||
Non-blocking I/O
|
||||
|
||||
Hands on
|
||||
--------
|
||||
|
||||
Community
|
||||
---------
|
||||
|
||||
Factor started in 2003
|
||||
About a dozen contributors
|
||||
Handful of "core contributors"
|
||||
Web site: http://factorcode.org
|
||||
IRC: #concatenative on irc.freenode.net
|
||||
Mailing list: factor-talk@lists.sf.net
|
||||
|
||||
C library interface
|
||||
-------------------
|
||||
|
||||
Efficient
|
||||
No need to write C code
|
||||
Supports floats, structs, unions, ...
|
||||
Function pointers, callbacks
|
||||
Here is an example
|
||||
|
||||
TerminateProcess
|
||||
|
||||
process-handle TerminateProcess
|
||||
|
|
@ -4,8 +4,8 @@ IN: nehe.2
|
|||
|
||||
TUPLE: nehe2-gadget < gadget ;
|
||||
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
|
||||
: <nehe2-gadget> ( -- gadget )
|
||||
nehe2-gadget new-gadget ;
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@ IN: nehe.3
|
|||
|
||||
TUPLE: nehe3-gadget < gadget ;
|
||||
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
|
||||
: <nehe3-gadget> ( -- gadget )
|
||||
nehe3-gadget new-gadget ;
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ IN: nehe.4
|
|||
|
||||
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
|
||||
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
: redraw-interval ( -- dt ) 10 milliseconds ;
|
||||
|
||||
: <nehe4-gadget> ( -- gadget )
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@ calendar ;
|
|||
IN: nehe.5
|
||||
|
||||
TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
|
||||
: width 256 ;
|
||||
: height 256 ;
|
||||
CONSTANT: width 256
|
||||
CONSTANT: height 256
|
||||
: redraw-interval ( -- dt ) 10 milliseconds ;
|
||||
|
||||
: <nehe5-gadget> ( -- gadget )
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ M: png-gadget ungraft* ( gadget -- )
|
|||
: $tetris ( element -- )
|
||||
drop [ <default-tetris> <tetris-gadget> gadget. ] ($block) ;
|
||||
|
||||
: otug-slides
|
||||
CONSTANT: otug-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
|
|
@ -361,7 +361,7 @@ var price = (order == null ? null : order.price);"> }
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
} ;
|
||||
}
|
||||
|
||||
: otug-talk ( -- ) otug-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ ui.gadgets.books ui.gadgets.panes ui.gestures ui.render
|
|||
parser accessors colors ;
|
||||
IN: slides
|
||||
|
||||
: stylesheet
|
||||
CONSTANT: stylesheet
|
||||
H{
|
||||
{ default-span-style
|
||||
H{
|
||||
|
|
@ -40,7 +40,7 @@ IN: slides
|
|||
H{ { table-gap { 10 20 } } }
|
||||
}
|
||||
{ bullet "\u0000b7" }
|
||||
} ;
|
||||
}
|
||||
|
||||
: $title ( string -- )
|
||||
[ H{ { font "sans-serif" } { font-size 48 } } format ] ($block) ;
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
|
|||
compiler.cfg.optimizer fry ;
|
||||
IN: vpri-talk
|
||||
|
||||
: vpri-slides
|
||||
CONSTANT: vpri-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
|
|
@ -485,7 +485,7 @@ IN: vpri-talk
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
} ;
|
||||
}
|
||||
|
||||
: vpri-talk ( -- ) vpri-slides slides-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -18,8 +18,7 @@ format similar-ok language country site subscription license ;
|
|||
first3 <result>
|
||||
] map ;
|
||||
|
||||
: yahoo-url ( -- str )
|
||||
URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" ;
|
||||
CONSTANT: yahoo-url URL" http://search.yahooapis.com/WebSearchService/V1/webSearch"
|
||||
|
||||
:: param ( search url name quot -- search url )
|
||||
search url search quot call
|
||||
|
|
@ -49,8 +48,7 @@ format similar-ok language country site subscription license ;
|
|||
"similar_ok" [ similar-ok>> ] bool-param
|
||||
nip ;
|
||||
|
||||
: factor-id
|
||||
"fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-" ;
|
||||
CONSTANT: factor-id "fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-"
|
||||
|
||||
: <search> ( query -- search )
|
||||
search new
|
||||
|
|
|
|||
|
|
@ -1,272 +0,0 @@
|
|||
! Based on http://research.sun.com/people/mario/java_benchmarking/
|
||||
! Ported by Factor by Slava Pestov
|
||||
!
|
||||
! Based on original version written in BCPL by Dr Martin Richards
|
||||
! in 1981 at Cambridge University Computer Laboratory, England
|
||||
! Java version: Copyright (C) 1995 Sun Microsystems, Inc.
|
||||
! by Jonathan Gibbons.
|
||||
! Outer loop added 8/7/96 by Alex Jacoby
|
||||
USING: values kernel accessors math math.bitwise sequences
|
||||
arrays combinators fry locals ;
|
||||
IN: benchmark.richards
|
||||
|
||||
! Packets
|
||||
TUPLE: packet link id kind a1 a2 ;
|
||||
|
||||
: BUFSIZE 4 ; inline
|
||||
|
||||
: <packet> ( link id kind -- packet )
|
||||
packet new
|
||||
swap >>kind
|
||||
swap >>id
|
||||
swap >>link
|
||||
0 >>a1
|
||||
BUFSIZE 0 <array> >>a2 ;
|
||||
|
||||
: last-packet ( packet -- last )
|
||||
dup link>> [ last-packet ] [ ] ?if ;
|
||||
|
||||
: append-to ( packet list -- packet )
|
||||
[ f >>link ] dip
|
||||
[ tuck last-packet >>link drop ] when* ;
|
||||
|
||||
! Tasks
|
||||
: I_IDLE 1 ; inline
|
||||
: I_WORK 2 ; inline
|
||||
: I_HANDLERA 3 ; inline
|
||||
: I_HANDLERB 4 ; inline
|
||||
: I_DEVA 5 ; inline
|
||||
: I_DEVB 6 ; inline
|
||||
|
||||
! Packet types
|
||||
: K_DEV 1000 ; inline
|
||||
: K_WORK 1001 ; inline
|
||||
|
||||
: PKTBIT 1 ; inline
|
||||
: WAITBIT 2 ; inline
|
||||
: HOLDBIT 4 ; inline
|
||||
|
||||
: S_RUN 0 ; inline
|
||||
: S_RUNPKT ( -- n ) { PKTBIT } flags ; inline
|
||||
: S_WAIT ( -- n ) { WAITBIT } flags ; inline
|
||||
: S_WAITPKT ( -- n ) { WAITBIT PKTBIT } flags ; inline
|
||||
: S_HOLD ( -- n ) { HOLDBIT } flags ; inline
|
||||
: S_HOLDPKT ( -- n ) { HOLDBIT PKTBIT } flags ; inline
|
||||
: S_HOLDWAIT ( -- n ) { HOLDBIT WAITBIT } flags ; inline
|
||||
: S_HOLDWAITPKT ( -- n ) { HOLDBIT WAITBIT PKTBIT } flags ; inline
|
||||
|
||||
: task-tab-size 10 ; inline
|
||||
|
||||
VALUE: task-tab
|
||||
VALUE: task-list
|
||||
VALUE: tracing
|
||||
VALUE: hold-count
|
||||
VALUE: qpkt-count
|
||||
|
||||
TUPLE: task link id pri wkq state ;
|
||||
|
||||
: new-task ( id pri wkq state class -- task )
|
||||
new
|
||||
swap >>state
|
||||
swap >>wkq
|
||||
swap >>pri
|
||||
swap >>id
|
||||
task-list >>link
|
||||
dup to: task-list
|
||||
dup dup id>> task-tab set-nth ; inline
|
||||
|
||||
GENERIC: fn ( packet task -- task )
|
||||
|
||||
: state-on ( task flag -- task )
|
||||
'[ _ bitor ] change-state ; inline
|
||||
|
||||
: state-off ( task flag -- task )
|
||||
'[ _ bitnot bitand ] change-state ; inline
|
||||
|
||||
: wait-task ( task -- task )
|
||||
WAITBIT state-on ;
|
||||
|
||||
: hold ( task -- task )
|
||||
hold-count 1+ to: hold-count
|
||||
HOLDBIT state-on
|
||||
link>> ;
|
||||
|
||||
: highest-priority ( t1 t2 -- t1/t2 )
|
||||
[ [ pri>> ] bi@ > ] most ;
|
||||
|
||||
: find-tcb ( i -- task )
|
||||
task-tab nth [ "Bad task" throw ] unless* ;
|
||||
|
||||
: release ( task i -- task )
|
||||
find-tcb HOLDBIT state-off highest-priority ;
|
||||
|
||||
:: qpkt ( task pkt -- task )
|
||||
[let | t [ pkt id>> find-tcb ] |
|
||||
t [
|
||||
qpkt-count 1+ to: qpkt-count
|
||||
f pkt (>>link)
|
||||
task id>> pkt (>>id)
|
||||
t wkq>> [
|
||||
pkt t wkq>> append-to t (>>wkq)
|
||||
task
|
||||
] [
|
||||
pkt t (>>wkq)
|
||||
t PKTBIT state-on drop
|
||||
t task highest-priority
|
||||
] if
|
||||
] [ task ] if
|
||||
] ;
|
||||
|
||||
: schedule-waitpkt ( task -- task pkt )
|
||||
dup wkq>>
|
||||
2dup link>> >>wkq drop
|
||||
2dup S_RUNPKT S_RUN ? >>state drop ; inline
|
||||
|
||||
: schedule-run ( task pkt -- task )
|
||||
swap fn ; inline
|
||||
|
||||
: schedule-wait ( task -- task )
|
||||
link>> ; inline
|
||||
|
||||
: (schedule) ( task -- )
|
||||
[
|
||||
dup state>> {
|
||||
{ S_WAITPKT [ schedule-waitpkt schedule-run (schedule) ] }
|
||||
{ S_RUN [ f schedule-run (schedule) ] }
|
||||
{ S_RUNPKT [ f schedule-run (schedule) ] }
|
||||
{ S_WAIT [ schedule-wait (schedule) ] }
|
||||
{ S_HOLD [ schedule-wait (schedule) ] }
|
||||
{ S_HOLDPKT [ schedule-wait (schedule) ] }
|
||||
{ S_HOLDWAIT [ schedule-wait (schedule) ] }
|
||||
{ S_HOLDWAITPKT [ schedule-wait (schedule) ] }
|
||||
[ 2drop ]
|
||||
} case
|
||||
] when* ;
|
||||
|
||||
: schedule ( -- )
|
||||
task-list (schedule) ;
|
||||
|
||||
! Device task
|
||||
TUPLE: device-task < task v1 ;
|
||||
|
||||
: <device-task> ( id pri wkq -- task )
|
||||
dup S_WAITPKT S_WAIT ? device-task new-task ;
|
||||
|
||||
M:: device-task fn ( pkt task -- task )
|
||||
pkt [
|
||||
task dup v1>>
|
||||
[ wait-task ]
|
||||
[ [ f ] change-v1 swap qpkt ] if
|
||||
] [ pkt task (>>v1) task hold ] if ;
|
||||
|
||||
TUPLE: handler-task < task workpkts devpkts ;
|
||||
|
||||
: <handler-task> ( id pri wkq -- task )
|
||||
dup S_WAITPKT S_WAIT ? handler-task new-task ;
|
||||
|
||||
M:: handler-task fn ( pkt task -- task )
|
||||
pkt [
|
||||
task over kind>> K_WORK =
|
||||
[ [ append-to ] change-workpkts ]
|
||||
[ [ append-to ] change-devpkts ]
|
||||
if drop
|
||||
] when*
|
||||
|
||||
task workpkts>> [
|
||||
[let* | devpkt [ task devpkts>> ]
|
||||
workpkt [ task workpkts>> ]
|
||||
count [ workpkt a1>> ] |
|
||||
count BUFSIZE > [
|
||||
workpkt link>> task (>>workpkts)
|
||||
task workpkt qpkt
|
||||
] [
|
||||
devpkt [
|
||||
devpkt link>> task (>>devpkts)
|
||||
count workpkt a2>> nth devpkt (>>a1)
|
||||
count 1+ workpkt (>>a1)
|
||||
task devpkt qpkt
|
||||
] [
|
||||
task wait-task
|
||||
] if
|
||||
] if
|
||||
]
|
||||
] [ task wait-task ] if ;
|
||||
|
||||
! Idle task
|
||||
TUPLE: idle-task < task { v1 fixnum } { v2 fixnum } ;
|
||||
|
||||
: <idle-task> ( i a1 a2 -- task )
|
||||
[ 0 f S_RUN idle-task new-task ] 2dip
|
||||
[ >>v1 ] [ >>v2 ] bi* ;
|
||||
|
||||
M: idle-task fn ( pkt task -- task )
|
||||
nip
|
||||
[ 1- ] change-v2
|
||||
dup v2>> 0 = [ hold ] [
|
||||
dup v1>> 1 bitand 0 = [
|
||||
[ -1 shift ] change-v1
|
||||
I_DEVA release
|
||||
] [
|
||||
[ -1 shift HEX: d008 bitor ] change-v1
|
||||
I_DEVB release
|
||||
] if
|
||||
] if ;
|
||||
|
||||
! Work task
|
||||
TUPLE: work-task < task { handler fixnum } { n fixnum } ;
|
||||
|
||||
: <work-task> ( id pri w -- work-task )
|
||||
dup S_WAITPKT S_WAIT ? work-task new-task
|
||||
I_HANDLERA >>handler
|
||||
0 >>n ;
|
||||
|
||||
M:: work-task fn ( pkt task -- task )
|
||||
pkt [
|
||||
task [ I_HANDLERA = I_HANDLERB I_HANDLERA ? ] change-handler drop
|
||||
task handler>> pkt (>>id)
|
||||
0 pkt (>>a1)
|
||||
BUFSIZE [| i |
|
||||
task [ 1+ ] change-n drop
|
||||
task n>> 26 > [ 1 task (>>n) ] when
|
||||
task n>> 1 - CHAR: A + i pkt a2>> set-nth
|
||||
] each
|
||||
task pkt qpkt
|
||||
] [ task wait-task ] if ;
|
||||
|
||||
! Main
|
||||
: init ( -- )
|
||||
task-tab-size f <array> to: task-tab
|
||||
f to: tracing
|
||||
0 to: hold-count
|
||||
0 to: qpkt-count ;
|
||||
|
||||
: start ( -- )
|
||||
I_IDLE 1 10000 <idle-task> drop
|
||||
|
||||
I_WORK 1000
|
||||
f 0 K_WORK <packet> 0 K_WORK <packet>
|
||||
<work-task> drop
|
||||
|
||||
I_HANDLERA 2000
|
||||
f I_DEVA K_DEV <packet>
|
||||
I_DEVA K_DEV <packet>
|
||||
I_DEVA K_DEV <packet>
|
||||
<handler-task> drop
|
||||
|
||||
I_HANDLERB 3000
|
||||
f I_DEVB K_DEV <packet>
|
||||
I_DEVB K_DEV <packet>
|
||||
I_DEVB K_DEV <packet>
|
||||
<handler-task> drop
|
||||
|
||||
I_DEVA 4000 f <device-task> drop
|
||||
I_DEVB 4000 f <device-task> drop ;
|
||||
|
||||
: check ( -- )
|
||||
qpkt-count 23246 assert=
|
||||
hold-count 9297 assert= ;
|
||||
|
||||
: run ( -- )
|
||||
init
|
||||
start
|
||||
schedule check ;
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
USING: kernel namespaces db.sql sequences math ;
|
||||
IN: db.sql.tests
|
||||
|
||||
! TUPLE: person name age ;
|
||||
: insert-1
|
||||
{ insert
|
||||
{
|
||||
{ table "person" }
|
||||
{ columns "name" "age" }
|
||||
{ values "erg" 26 }
|
||||
}
|
||||
} ;
|
||||
|
||||
: update-1
|
||||
{ update "person"
|
||||
{ set { "name" "erg" }
|
||||
{ "age" 6 } }
|
||||
{ where { "age" 6 } }
|
||||
} ;
|
||||
|
||||
: select-1
|
||||
{ select
|
||||
{ columns
|
||||
"branchno"
|
||||
{ count "staffno" as "mycount" }
|
||||
{ sum "salary" as "mysum" } }
|
||||
{ from "staff" "lol" }
|
||||
{ where
|
||||
{ "salary" > all
|
||||
{ select
|
||||
{ columns "salary" }
|
||||
{ from "staff" }
|
||||
{ where { "branchno" = "b003" } }
|
||||
}
|
||||
}
|
||||
{ "branchno" > 3 } }
|
||||
{ group-by "branchno" "lol2" }
|
||||
{ having { count "staffno" > 1 } }
|
||||
{ order-by "branchno" }
|
||||
{ offset 40 }
|
||||
{ limit 20 }
|
||||
} ;
|
||||
|
|
@ -1,172 +0,0 @@
|
|||
USING: kernel parser quotations classes.tuple words math.order
|
||||
nmake namespaces sequences arrays combinators
|
||||
prettyprint strings math.parser math symbols db ;
|
||||
IN: db.sql
|
||||
|
||||
SYMBOLS: insert update delete select distinct columns from as
|
||||
where group-by having order-by limit offset is-null desc all
|
||||
any count avg table values ;
|
||||
|
||||
: input-spec, ( obj -- ) 1, ;
|
||||
: output-spec, ( obj -- ) 2, ;
|
||||
: input, ( obj -- ) 3, ;
|
||||
: output, ( obj -- ) 4, ;
|
||||
|
||||
DEFER: sql%
|
||||
|
||||
: (sql-interleave) ( seq sep -- )
|
||||
[ sql% ] curry [ sql% ] interleave ;
|
||||
|
||||
: sql-interleave ( seq str sep -- )
|
||||
swap sql% (sql-interleave) ;
|
||||
|
||||
: sql-function, ( seq function -- )
|
||||
sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ;
|
||||
|
||||
: sql-where, ( seq -- )
|
||||
[
|
||||
[ second 0, ]
|
||||
[ first 0, ]
|
||||
[ third 1, \ ? 0, ] tri
|
||||
] each ;
|
||||
|
||||
HOOK: sql-create db ( object -- )
|
||||
M: db sql-create ( object -- )
|
||||
drop
|
||||
"create table" sql% ;
|
||||
|
||||
HOOK: sql-drop db ( object -- )
|
||||
M: db sql-drop ( object -- )
|
||||
drop
|
||||
"drop table" sql% ;
|
||||
|
||||
HOOK: sql-insert db ( object -- )
|
||||
M: db sql-insert ( object -- )
|
||||
drop
|
||||
"insert into" sql% ;
|
||||
|
||||
HOOK: sql-update db ( object -- )
|
||||
M: db sql-update ( object -- )
|
||||
drop
|
||||
"update" sql% ;
|
||||
|
||||
HOOK: sql-delete db ( object -- )
|
||||
M: db sql-delete ( object -- )
|
||||
drop
|
||||
"delete" sql% ;
|
||||
|
||||
HOOK: sql-select db ( object -- )
|
||||
M: db sql-select ( object -- )
|
||||
"select" sql% "," (sql-interleave) ;
|
||||
|
||||
HOOK: sql-columns db ( object -- )
|
||||
M: db sql-columns ( object -- )
|
||||
"," (sql-interleave) ;
|
||||
|
||||
HOOK: sql-from db ( object -- )
|
||||
M: db sql-from ( object -- )
|
||||
"from" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-where db ( object -- )
|
||||
M: db sql-where ( object -- )
|
||||
"where" 0, sql-where, ;
|
||||
|
||||
HOOK: sql-group-by db ( object -- )
|
||||
M: db sql-group-by ( object -- )
|
||||
"group by" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-having db ( object -- )
|
||||
M: db sql-having ( object -- )
|
||||
"having" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-order-by db ( object -- )
|
||||
M: db sql-order-by ( object -- )
|
||||
"order by" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-offset db ( object -- )
|
||||
M: db sql-offset ( object -- )
|
||||
"offset" sql% sql% ;
|
||||
|
||||
HOOK: sql-limit db ( object -- )
|
||||
M: db sql-limit ( object -- )
|
||||
"limit" sql% sql% ;
|
||||
|
||||
! GENERIC: sql-subselect db ( object -- )
|
||||
! M: db sql-subselectselect ( object -- )
|
||||
! "(select" sql% sql% ")" sql% ;
|
||||
|
||||
HOOK: sql-table db ( object -- )
|
||||
M: db sql-table ( object -- )
|
||||
sql% ;
|
||||
|
||||
HOOK: sql-set db ( object -- )
|
||||
M: db sql-set ( object -- )
|
||||
"set" "," sql-interleave ;
|
||||
|
||||
HOOK: sql-values db ( object -- )
|
||||
M: db sql-values ( object -- )
|
||||
"values(" sql% "," (sql-interleave) ")" sql% ;
|
||||
|
||||
HOOK: sql-count db ( object -- )
|
||||
M: db sql-count ( object -- )
|
||||
"count" sql-function, ;
|
||||
|
||||
HOOK: sql-sum db ( object -- )
|
||||
M: db sql-sum ( object -- )
|
||||
"sum" sql-function, ;
|
||||
|
||||
HOOK: sql-avg db ( object -- )
|
||||
M: db sql-avg ( object -- )
|
||||
"avg" sql-function, ;
|
||||
|
||||
HOOK: sql-min db ( object -- )
|
||||
M: db sql-min ( object -- )
|
||||
"min" sql-function, ;
|
||||
|
||||
HOOK: sql-max db ( object -- )
|
||||
M: db sql-max ( object -- )
|
||||
"max" sql-function, ;
|
||||
|
||||
: sql-array% ( array -- )
|
||||
unclip
|
||||
{
|
||||
{ \ create [ sql-create ] }
|
||||
{ \ drop [ sql-drop ] }
|
||||
{ \ insert [ sql-insert ] }
|
||||
{ \ update [ sql-update ] }
|
||||
{ \ delete [ sql-delete ] }
|
||||
{ \ select [ sql-select ] }
|
||||
{ \ columns [ sql-columns ] }
|
||||
{ \ from [ sql-from ] }
|
||||
{ \ where [ sql-where ] }
|
||||
{ \ group-by [ sql-group-by ] }
|
||||
{ \ having [ sql-having ] }
|
||||
{ \ order-by [ sql-order-by ] }
|
||||
{ \ offset [ sql-offset ] }
|
||||
{ \ limit [ sql-limit ] }
|
||||
{ \ table [ sql-table ] }
|
||||
{ \ set [ sql-set ] }
|
||||
{ \ values [ sql-values ] }
|
||||
{ \ count [ sql-count ] }
|
||||
{ \ sum [ sql-sum ] }
|
||||
{ \ avg [ sql-avg ] }
|
||||
{ \ min [ sql-min ] }
|
||||
{ \ max [ sql-max ] }
|
||||
[ sql% [ sql% ] each ]
|
||||
} case ;
|
||||
|
||||
ERROR: no-sql-match ;
|
||||
: sql% ( obj -- )
|
||||
{
|
||||
{ [ dup string? ] [ 0, ] }
|
||||
{ [ dup array? ] [ sql-array% ] }
|
||||
{ [ dup number? ] [ number>string sql% ] }
|
||||
{ [ dup symbol? ] [ unparse sql% ] }
|
||||
{ [ dup word? ] [ unparse sql% ] }
|
||||
{ [ dup quotation? ] [ call ] }
|
||||
[ no-sql-match ]
|
||||
} cond ;
|
||||
|
||||
: parse-sql ( obj -- sql in-spec out-spec in out )
|
||||
[ [ sql% ] each ] { { } { } { } } nmake
|
||||
[ " " join ] 2dip ;
|
||||
Loading…
Reference in New Issue