From eaad0c766018f8c3eec6cb242a3169e911f975bb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 23 Feb 2009 21:40:17 -0600 Subject: [PATCH] Updating code to use CONSTANT: instead of : foo 123 ; inline --- .../bootstrap/image/download/download.factor | 2 +- basis/cairo/ffi/ffi.factor | 6 +- basis/farkup/farkup.factor | 2 +- basis/furnace/actions/actions.factor | 2 +- basis/furnace/alloy/alloy.factor | 2 +- basis/furnace/asides/asides.factor | 2 +- basis/furnace/auth/login/login.factor | 2 +- basis/furnace/auth/providers/null/null.factor | 4 +- .../conversations/conversations.factor | 2 +- basis/furnace/sessions/sessions.factor | 2 +- basis/furnace/utilities/utilities.factor | 4 +- .../html/templates/chloe/syntax/syntax.factor | 2 +- basis/io/encodings/8-bit/8-bit.factor | 11 +- basis/logging/server/server.factor | 2 +- basis/math/quaternions/quaternions.factor | 10 +- basis/windows/kernel32/kernel32.factor | 4 +- basis/x11/constants/constants.factor | 350 +++++++++--------- basis/x11/glx/glx.factor | 34 +- basis/x11/xim/xim.factor | 2 +- basis/xml/entities/entities.factor | 12 +- basis/xml/errors/errors.factor | 4 +- extra/24-game/24-game.factor | 2 +- extra/benchmark/backtrack/backtrack.factor | 4 +- extra/benchmark/fasta/fasta.factor | 10 +- extra/benchmark/raytracer/raytracer.factor | 7 +- extra/benchmark/sockets/sockets.factor | 2 +- extra/galois-talk/galois-talk.factor | 4 +- extra/game-input/iokit/iokit.factor | 4 +- .../google-tech-talk/google-tech-talk.factor | 4 +- extra/irc/client/client.factor | 2 +- extra/irc/ui/ui.factor | 6 +- extra/joystick-demo/joystick-demo.factor | 8 +- extra/key-caps/key-caps.factor | 6 +- extra/lint/lint.factor | 2 +- extra/lisppaste/lisppaste.factor | 2 +- extra/mason/common/common.factor | 28 +- extra/math/analysis/analysis.factor | 4 +- extra/maze/maze.factor | 2 +- .../minneapolis-talk/minneapolis-talk.factor | 4 +- extra/minneapolis-talk/minneapolis-talk.txt | 116 ------ extra/nehe/2/2.factor | 4 +- extra/nehe/3/3.factor | 4 +- extra/nehe/4/4.factor | 4 +- extra/nehe/5/5.factor | 4 +- extra/otug-talk/otug-talk.factor | 4 +- extra/slides/slides.factor | 4 +- extra/vpri-talk/vpri-talk.factor | 4 +- extra/yahoo/yahoo.factor | 6 +- unfinished/benchmark/richards/richards.factor | 272 -------------- unfinished/sql/sql-tests.factor | 42 --- unfinished/sql/sql.factor | 172 --------- 51 files changed, 295 insertions(+), 903 deletions(-) delete mode 100755 extra/minneapolis-talk/minneapolis-talk.txt delete mode 100644 unfinished/benchmark/richards/richards.factor delete mode 100644 unfinished/sql/sql-tests.factor delete mode 100755 unfinished/sql/sql.factor diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index f9b7b56779..5bfc5f7ccc 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -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 diff --git a/basis/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor index d29a3fb097..c2daa05374 100644 --- a/basis/cairo/ffi/ffi.factor +++ b/basis/cairo/ffi/ffi.factor @@ -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 ) diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index eea30a3040..50ee938659 100755 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -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' ) { diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 97cb73c9cb..166d2a88a2 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -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 diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor index 0fe80427b9..dc280c1e44 100644 --- a/basis/furnace/alloy/alloy.factor +++ b/basis/furnace/alloy/alloy.factor @@ -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 diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor index 7489d19f94..ecf6d0a628 100644 --- a/basis/furnace/asides/asides.factor +++ b/basis/furnace/asides/asides.factor @@ -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 ; diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor index 0ceafa7f86..915ae1c224 100644 --- a/basis/furnace/auth/login/login.factor +++ b/basis/furnace/auth/login/login.factor @@ -64,7 +64,7 @@ SYMBOL: capabilities PRIVATE> -: flashed-variables { description capabilities } ; +CONSTANT: flashed-variables { description capabilities } : login-failed ( -- * ) "invalid username or password" validation-error diff --git a/basis/furnace/auth/providers/null/null.factor b/basis/furnace/auth/providers/null/null.factor index 39ea812ae7..0fab3c5b09 100644 --- a/basis/furnace/auth/providers/null/null.factor +++ b/basis/furnace/auth/providers/null/null.factor @@ -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 ; diff --git a/basis/furnace/conversations/conversations.factor b/basis/furnace/conversations/conversations.factor index 266958c8a4..bbb84e2f05 100644 --- a/basis/furnace/conversations/conversations.factor +++ b/basis/furnace/conversations/conversations.factor @@ -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 ; diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor index 52e705c153..3eb7a11215 100644 --- a/basis/furnace/sessions/sessions.factor +++ b/basis/furnace/sessions/sessions.factor @@ -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?>> [ diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 4fc68f7735..c0cb7dbced 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -89,7 +89,7 @@ M: object modify-form drop f ; [XML 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 ) diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor index faf8bed66b..9e7079023d 100644 --- a/basis/html/templates/chloe/syntax/syntax.factor +++ b/basis/html/templates/chloe/syntax/syntax.factor @@ -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 = ; diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index bad2d9fd82..9ef2b07322 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -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 ch ( assoc -- array ) 256 replacement-char - [ [ swapd set-nth ] curry assoc-each ] keep ; + [ '[ swap _ set-nth ] assoc-each ] keep ; : ch>byte ( assoc -- newassoc ) [ swap ] assoc-map >hashtable ; diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor index 618dba544c..7dced852fd 100644 --- a/basis/logging/server/server.factor +++ b/basis/logging/server/server.factor @@ -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 ; diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor index bc6da9f564..f2c2c6d226 100755 --- a/basis/math/quaternions/quaternions.factor +++ b/basis/math/quaternions/quaternions.factor @@ -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 diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 8a271f7210..36acc5e346 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -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 diff --git a/basis/x11/constants/constants.factor b/basis/x11/constants/constants.factor index fcce09380f..1fe825d6af 100644 --- a/basis/x11/constants/constants.factor +++ b/basis/x11/constants/constants.factor @@ -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 diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor index 11473d6e83..e6001d3e59 100644 --- a/basis/x11/glx/glx.factor +++ b/basis/x11/glx/glx.factor @@ -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 diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor index 534e47ac37..e06872fa83 100644 --- a/basis/x11/xim/xim.factor +++ b/basis/x11/xim/xim.factor @@ -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 diff --git a/basis/xml/entities/entities.factor b/basis/xml/entities/entities.factor index 3e768b1b88..7eac725052 100644 --- a/basis/xml/entities/entities.factor +++ b/basis/xml/entities/entities.factor @@ -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 diff --git a/basis/xml/errors/errors.factor b/basis/xml/errors/errors.factor index 304b38f2bd..35111f5a54 100644 --- a/basis/xml/errors/errors.factor +++ b/basis/xml/errors/errors.factor @@ -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 diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor index f842d5f4cb..f22ca001f4 100644 --- a/extra/24-game/24-game.factor +++ b/extra/24-game/24-game.factor @@ -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 ) diff --git a/extra/benchmark/backtrack/backtrack.factor b/extra/benchmark/backtrack/backtrack.factor index df67872b11..0ae7d792dd 100755 --- a/extra/benchmark/backtrack/backtrack.factor +++ b/extra/benchmark/backtrack/backtrack.factor @@ -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 diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 61d9e9fd43..2ae5ada8a1 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -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 diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index 8d07ae1c65..a4df1fe04d 100755 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -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 diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index 20c905156b..d6e4f29b86 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -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 ; diff --git a/extra/galois-talk/galois-talk.factor b/extra/galois-talk/galois-talk.factor index 259fa446af..ccba90fb6f 100644 --- a/extra/galois-talk/galois-talk.factor +++ b/extra/galois-talk/galois-talk.factor @@ -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 ; diff --git a/extra/game-input/iokit/iokit.factor b/extra/game-input/iokit/iokit.factor index 8a10535306..254ed61ab0 100755 --- a/extra/game-input/iokit/iokit.factor +++ b/extra/game-input/iokit/iokit.factor @@ -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 ; diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor index 9bd3c5854b..4d4e3b0507 100644 --- a/extra/google-tech-talk/google-tech-talk.factor +++ b/extra/google-tech-talk/google-tech-talk.factor @@ -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 ; diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 0eba6f6af5..2770471093 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -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 diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 59e4cf6cb4..791639d260 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -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 ) [ "." ] diff --git a/extra/joystick-demo/joystick-demo.factor b/extra/joystick-demo/joystick-demo.factor index 9e457c7bdd..188095dd2e 100755 --- a/extra/joystick-demo/joystick-demo.factor +++ b/extra/joystick-demo/joystick-demo.factor @@ -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 } } } - } ; + } : ( color -- indicator ) indicator-polygon ; diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor index 05edb205d2..acf20f90ab 100755 --- a/extra/key-caps/key-caps.factor +++ b/extra/key-caps/key-caps.factor @@ -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 ; diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index 849cc540a3..9877c70062 100755 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -42,7 +42,7 @@ SYMBOL: def-hash-keys set-alien-float alien-float } ; -: trivial-defs +: trivial-defs ( -- seq ) { [ drop ] [ 2array ] [ bitand ] diff --git a/extra/lisppaste/lisppaste.factor b/extra/lisppaste/lisppaste.factor index df85f01f26..43b5b78097 100644 --- a/extra/lisppaste/lisppaste.factor +++ b/extra/lisppaste/lisppaste.factor @@ -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 ; diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index ec0cbdbc9c..3cd38e1ff4 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -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 diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index 9c773f748e..fa01b0376d 100755 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -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 ; diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor index de345e732e..a490a8bbfc 100644 --- a/extra/maze/maze.factor +++ b/extra/maze/maze.factor @@ -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 diff --git a/extra/minneapolis-talk/minneapolis-talk.factor b/extra/minneapolis-talk/minneapolis-talk.factor index 25bad4061a..6f1df44bfb 100755 --- a/extra/minneapolis-talk/minneapolis-talk.factor +++ b/extra/minneapolis-talk/minneapolis-talk.factor @@ -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 ; diff --git a/extra/minneapolis-talk/minneapolis-talk.txt b/extra/minneapolis-talk/minneapolis-talk.txt deleted file mode 100755 index 5310accf5b..0000000000 --- a/extra/minneapolis-talk/minneapolis-talk.txt +++ /dev/null @@ -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 diff --git a/extra/nehe/2/2.factor b/extra/nehe/2/2.factor index 29d4ccffc1..fdb53ef254 100644 --- a/extra/nehe/2/2.factor +++ b/extra/nehe/2/2.factor @@ -4,8 +4,8 @@ IN: nehe.2 TUPLE: nehe2-gadget < gadget ; -: width 256 ; -: height 256 ; +CONSTANT: width 256 +CONSTANT: height 256 : ( -- gadget ) nehe2-gadget new-gadget ; diff --git a/extra/nehe/3/3.factor b/extra/nehe/3/3.factor index 75f2e573cc..557655a029 100644 --- a/extra/nehe/3/3.factor +++ b/extra/nehe/3/3.factor @@ -4,8 +4,8 @@ IN: nehe.3 TUPLE: nehe3-gadget < gadget ; -: width 256 ; -: height 256 ; +CONSTANT: width 256 +CONSTANT: height 256 : ( -- gadget ) nehe3-gadget new-gadget ; diff --git a/extra/nehe/4/4.factor b/extra/nehe/4/4.factor index fda22d2f1e..00308277ea 100644 --- a/extra/nehe/4/4.factor +++ b/extra/nehe/4/4.factor @@ -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 ; : ( -- gadget ) diff --git a/extra/nehe/5/5.factor b/extra/nehe/5/5.factor index 30d0991fd8..3723014c83 100755 --- a/extra/nehe/5/5.factor +++ b/extra/nehe/5/5.factor @@ -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 ; : ( -- gadget ) diff --git a/extra/otug-talk/otug-talk.factor b/extra/otug-talk/otug-talk.factor index b52749dbe1..ef5782dda7 100644 --- a/extra/otug-talk/otug-talk.factor +++ b/extra/otug-talk/otug-talk.factor @@ -39,7 +39,7 @@ M: png-gadget ungraft* ( gadget -- ) : $tetris ( element -- ) drop [ 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 ; diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index 0ce946dc49..ba21ba9c84 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -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) ; diff --git a/extra/vpri-talk/vpri-talk.factor b/extra/vpri-talk/vpri-talk.factor index 35d8bb52ff..5d7620101f 100644 --- a/extra/vpri-talk/vpri-talk.factor +++ b/extra/vpri-talk/vpri-talk.factor @@ -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 ; diff --git a/extra/yahoo/yahoo.factor b/extra/yahoo/yahoo.factor index b58a11747f..5e0c08b430 100755 --- a/extra/yahoo/yahoo.factor +++ b/extra/yahoo/yahoo.factor @@ -18,8 +18,7 @@ format similar-ok language country site subscription license ; first3 ] 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-" : ( query -- search ) search new diff --git a/unfinished/benchmark/richards/richards.factor b/unfinished/benchmark/richards/richards.factor deleted file mode 100644 index 90d4304eee..0000000000 --- a/unfinished/benchmark/richards/richards.factor +++ /dev/null @@ -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 - -: ( link id kind -- packet ) - packet new - swap >>kind - swap >>id - swap >>link - 0 >>a1 - BUFSIZE 0 >>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 ; - -: ( 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 ; - -: ( 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 } ; - -: ( 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 } ; - -: ( 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 to: task-tab - f to: tracing - 0 to: hold-count - 0 to: qpkt-count ; - -: start ( -- ) - I_IDLE 1 10000 drop - - I_WORK 1000 - f 0 K_WORK 0 K_WORK - drop - - I_HANDLERA 2000 - f I_DEVA K_DEV - I_DEVA K_DEV - I_DEVA K_DEV - drop - - I_HANDLERB 3000 - f I_DEVB K_DEV - I_DEVB K_DEV - I_DEVB K_DEV - drop - - I_DEVA 4000 f drop - I_DEVB 4000 f drop ; - -: check ( -- ) - qpkt-count 23246 assert= - hold-count 9297 assert= ; - -: run ( -- ) - init - start - schedule check ; diff --git a/unfinished/sql/sql-tests.factor b/unfinished/sql/sql-tests.factor deleted file mode 100644 index 0b57c2d8fa..0000000000 --- a/unfinished/sql/sql-tests.factor +++ /dev/null @@ -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 } - } ; diff --git a/unfinished/sql/sql.factor b/unfinished/sql/sql.factor deleted file mode 100755 index ba0673ae24..0000000000 --- a/unfinished/sql/sql.factor +++ /dev/null @@ -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 ;