From 94a613f688605eaa9c4fa0a5bc94efc1d47279cb Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Tue, 8 Jul 2008 20:40:37 +0200 Subject: [PATCH 1/9] Small change: use a better idiom --- extra/ctags/ctags.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index c8bf2272fb..23d9aeb90c 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -22,7 +22,7 @@ IN: ctags { } swap [ ctag suffix ] each ; : ctags-write ( seq path -- ) - >r ctag-strings r> ascii set-file-lines ; + [ ctag-strings ] dip ascii set-file-lines ; : (ctags) ( -- seq ) { } all-words [ From 3e43c69918aa1c1f6b93359a4593011532d90901 Mon Sep 17 00:00:00 2001 From: Alfredo Beaumont Date: Tue, 8 Jul 2008 21:57:37 +0200 Subject: [PATCH 2/9] Fix examples' code and make them unchecked since they have side effects --- extra/ctags/ctags-docs.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor index 9d98cae0b3..22d811ad3f 100644 --- a/extra/ctags/ctags-docs.factor +++ b/extra/ctags/ctags-docs.factor @@ -12,9 +12,9 @@ HELP: ctags ( path -- ) { $values { "path" "a pathname string" } } { $description "Generates a index file in ctags format and stores in " { $snippet "path" } "." } { $examples - { $example + { $unchecked-example "USING: ctags ;" - "\"tags\" ctags-write" + "\"tags\" ctags" "" } } ; @@ -24,7 +24,7 @@ HELP: ctags-write ( seq path -- ) { "path" "a pathname string" } } { $description "Stores a " { $snippet "alist" } " in " { $snippet "path" } ". " { $snippet "alist" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" } { $examples - { $example + { $unchecked-example "USING: kernel ctags ;" "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } \"tags\" ctags-write" "" @@ -38,9 +38,9 @@ HELP: ctag-strings ( alist -- seq ) { "seq" sequence } } { $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." } { $examples - { $example - "USING: kernel ctags ;" - "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings" + { $unchecked-example + "USING: kernel ctags prettyprint ;" + "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings ." "{ \"if\\t/path/to/factor/extra/unix/unix.factor\\t91\" }" } } ; @@ -50,8 +50,8 @@ HELP: ctag ( seq -- str ) { "str" string } } { $description "Outputs a string " { $snippet "str" } " in ctag format for sequence with two elements, first one must be a valid word and second one a sequence whose first element is a resource name and second element is a line number" } { $examples - { $example - "USING: kernel ctags ;" + { $unchecked-example + "USING: kernel ctags prettyprint ;" "{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag ." "\"if\\t/path/to/factor/extra/unix/unix.factor\\t91\"" } From 6ad09779cc3e20a33aa2d527606d62eb2e82f410 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 15:46:52 -0500 Subject: [PATCH 3/9] Literal aliens in source files are bade bad --- extra/db/pools/pools-tests.factor | 16 +++++++++++++++- extra/io/pools/pools.factor | 2 +- extra/windows/user32/user32.factor | 8 ++++---- 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/extra/db/pools/pools-tests.factor b/extra/db/pools/pools-tests.factor index f0534a1d34..34e072c3a5 100644 --- a/extra/db/pools/pools-tests.factor +++ b/extra/db/pools/pools-tests.factor @@ -1,8 +1,22 @@ IN: db.pools.tests -USING: db.pools tools.test ; +USING: db.pools tools.test continuations io.files namespaces +accessors kernel math destructors ; \ must-infer { 2 0 } [ [ ] with-db-pool ] must-infer-as { 1 0 } [ [ ] with-pooled-db ] must-infer-as + +! Test behavior after image save/load +USE: db.sqlite + +[ "pool-test.db" temp-file delete-file ] ignore-errors + +[ ] [ "pool-test.db" sqlite-db "pool" set ] unit-test + +[ ] [ "pool" get expired>> t >>expired drop ] unit-test + +[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test + +[ ] [ "pool" get dispose ] unit-test diff --git a/extra/io/pools/pools.factor b/extra/io/pools/pools.factor index 0e37e41a76..aa734e6809 100644 --- a/extra/io/pools/pools.factor +++ b/extra/io/pools/pools.factor @@ -9,7 +9,7 @@ TUPLE: pool connections disposed expired ; : check-pool ( pool -- ) dup check-disposed dup expired>> expired? [ - ALIEN: 31337 >>expired + 31337 >>expired connections>> delete-all ] [ drop ] if ; diff --git a/extra/windows/user32/user32.factor b/extra/windows/user32/user32.factor index 1c1df52da8..241eddf9f0 100755 --- a/extra/windows/user32/user32.factor +++ b/extra/windows/user32/user32.factor @@ -1285,10 +1285,10 @@ FUNCTION: void SetLastErrorEx ( DWORD dwErrCode, DWORD dwType ) ; ! FUNCTION: SetWindowPlacement FUNCTION: BOOL SetWindowPos ( HWND hWnd, HWND hWndInsertAfter, int X, int Y, int cx, int cy, UINT uFlags ) ; -: HWND_BOTTOM ALIEN: 1 ; -: HWND_NOTOPMOST ALIEN: -2 ; -: HWND_TOP ALIEN: 0 ; -: HWND_TOPMOST ALIEN: -1 ; +: HWND_BOTTOM ( -- alien ) 1 ; +: HWND_NOTOPMOST ( -- alien ) -2 ; +: HWND_TOP ( -- alien ) 0 ; +: HWND_TOPMOST ( -- alien ) -1 ; ! FUNCTION: SetWindowRgn ! FUNCTION: SetWindowsHookA From 3b2f4d92d2c11e409fe12bae6246a4bf67486e00 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 15:50:12 -0500 Subject: [PATCH 4/9] Check if the handle has been disposed. This can happen if we close one end of a duplex stream --- extra/io/unix/backend/backend.factor | 7 +++++-- extra/io/windows/files/files.factor | 1 + extra/io/windows/nt/backend/backend.factor | 2 +- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 165747084e..b984b1f156 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -125,7 +125,8 @@ M: fd refill } cond ; M: unix (wait-to-read) ( port -- ) - dup dup handle>> refill dup + dup + dup handle>> dup check-disposed refill dup [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; ! Writers @@ -144,7 +145,9 @@ M: fd drain } cond ; M: unix (wait-to-write) ( port -- ) - dup dup handle>> drain dup [ wait-for-port ] [ 2drop ] if ; + dup + dup handle>> dup check-disposed drain + dup [ wait-for-port ] [ 2drop ] if ; M: unix io-multiplex ( ms/f -- ) mx get-global wait-for-events ; diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 419509f124..e25be71872 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -61,6 +61,7 @@ C: FileArgs : make-FileArgs ( port -- ) { + [ handle>> check-disposed ] [ handle>> handle>> ] [ buffer>> ] [ buffer>> buffer-length ] diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 786275c736..e9df2ddab9 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -74,7 +74,7 @@ M: winnt add-completion ( win32-handle -- ) ] if ; M: win32-handle cancel-operation - handle>> CancelIo drop ; + [ check-disposed ] [ handle>> CancelIo drop ] bi ; M: winnt io-multiplex ( ms -- ) handle-overlapped [ 0 io-multiplex ] when ; From 75338b577cb39d836b0da548f6f1d08f9f08daf9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 15:50:38 -0500 Subject: [PATCH 5/9] Rename from-now to hence --- extra/alarms/alarms-docs.factor | 2 +- extra/alarms/alarms.factor | 4 ++-- extra/calendar/calendar.factor | 4 ++-- extra/furnace/auth/login/login.factor | 3 +-- extra/furnace/cache/cache.factor | 4 ++-- extra/furnace/sessions/sessions.factor | 1 - extra/tetris/tetris.factor | 2 +- extra/ui/gestures/gestures.factor | 2 +- 8 files changed, 10 insertions(+), 12 deletions(-) diff --git a/extra/alarms/alarms-docs.factor b/extra/alarms/alarms-docs.factor index b25df236c9..f07a8b9a2d 100755 --- a/extra/alarms/alarms-docs.factor +++ b/extra/alarms/alarms-docs.factor @@ -10,7 +10,7 @@ HELP: add-alarm HELP: later { $values { "quot" quotation } { "dt" duration } { "alarm" alarm } } -{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } { $link from-now } "." } ; +{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ; HELP: cancel-alarm { $values { "alarm" alarm } } diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor index ddc1d34121..a72960f20f 100755 --- a/extra/alarms/alarms.factor +++ b/extra/alarms/alarms.factor @@ -82,10 +82,10 @@ PRIVATE> [ register-alarm ] keep ; : later ( quot dt -- alarm ) - from-now f add-alarm ; + hence f add-alarm ; : every ( quot dt -- alarm ) - [ from-now ] keep add-alarm ; + [ hence ] keep add-alarm ; : cancel-alarm ( alarm -- ) alarm-entry [ alarms get-global heap-delete ] if-box? ; diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index e7b0b6f43a..0abc00b4a4 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -284,7 +284,7 @@ MEMO: unix-1970 ( -- timestamp ) : now ( -- timestamp ) gmt >local-time ; -: from-now ( dt -- timestamp ) now swap time+ ; +: hence ( dt -- timestamp ) now swap time+ ; : ago ( dt -- timestamp ) now swap time- ; : day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline @@ -357,7 +357,7 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; M: timestamp sleep-until timestamp>millis sleep-until ; -M: duration sleep from-now sleep-until ; +M: duration sleep hence sleep-until ; { { [ os unix? ] [ "calendar.unix" ] } diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor index 68161382c1..ce533bce64 100755 --- a/extra/furnace/auth/login/login.factor +++ b/extra/furnace/auth/login/login.factor @@ -40,10 +40,9 @@ M: login-realm modify-form ( responder -- ) permit-id get realm get name>> permit-id-key "$login-realm" resolve-base-path >>path realm get - [ timeout>> from-now >>expires ] [ domain>> >>domain ] [ secure>> >>secure ] - tri ; + bi ; : put-permit-cookie ( response -- response' ) put-cookie ; diff --git a/extra/furnace/cache/cache.factor b/extra/furnace/cache/cache.factor index a614a52548..68786a55ab 100644 --- a/extra/furnace/cache/cache.factor +++ b/extra/furnace/cache/cache.factor @@ -31,6 +31,6 @@ TUPLE: server-state-manager < filter-responder timeout ; new swap >>responder 20 minutes >>timeout ; inline - + : touch-state ( state manager -- ) - timeout>> from-now >>expires drop ; + timeout>> hence >>expires drop ; diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor index 0ec9648a67..5590a9e55e 100755 --- a/extra/furnace/sessions/sessions.factor +++ b/extra/furnace/sessions/sessions.factor @@ -116,7 +116,6 @@ M: session-saver dispose : ( -- cookie ) session get id>> session-id-key "$sessions" resolve-base-path >>path - sessions get timeout>> from-now >>expires sessions get domain>> >>domain ; : put-session-cookie ( response -- response' ) diff --git a/extra/tetris/tetris.factor b/extra/tetris/tetris.factor index 02f8f240d2..c2f874598c 100644 --- a/extra/tetris/tetris.factor +++ b/extra/tetris/tetris.factor @@ -45,7 +45,7 @@ tetris-gadget H{ dup tetris-gadget-tetris maybe-update relayout-1 ; M: tetris-gadget graft* ( gadget -- ) - dup [ tick ] curry 100 milliseconds from-now 100 milliseconds add-alarm + dup [ tick ] curry 100 milliseconds every swap set-tetris-gadget-alarm ; M: tetris-gadget ungraft* ( gadget -- ) diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor index 88bc2bcee7..5c00fbfdb0 100755 --- a/extra/ui/gestures/gestures.factor +++ b/extra/ui/gestures/gestures.factor @@ -121,7 +121,7 @@ SYMBOL: drag-timer : start-drag-timer ( -- ) hand-buttons get-global empty? [ [ drag-gesture ] - 300 milliseconds from-now + 300 milliseconds hence 100 milliseconds add-alarm drag-timer get-global >box ] when ; From 7c76046d3b65654306c08a7d0d539ea3e04d5bfd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 16:15:51 -0500 Subject: [PATCH 6/9] Minor Wiki improvements --- extra/webapps/planet/mini-planet.xml | 14 ----- extra/webapps/wiki/initial-content/Farkup.txt | 63 +++++++++++++++++++ .../wiki/initial-content/Front Page.txt | 5 ++ extra/webapps/wiki/wiki-common.xml | 11 ++++ extra/webapps/wiki/wiki.factor | 29 +++++++-- .../concatenative/concatenative.factor | 2 +- 6 files changed, 105 insertions(+), 19 deletions(-) delete mode 100644 extra/webapps/planet/mini-planet.xml create mode 100644 extra/webapps/wiki/initial-content/Farkup.txt create mode 100644 extra/webapps/wiki/initial-content/Front Page.txt diff --git a/extra/webapps/planet/mini-planet.xml b/extra/webapps/planet/mini-planet.xml deleted file mode 100644 index 661c2dc0f7..0000000000 --- a/extra/webapps/planet/mini-planet.xml +++ /dev/null @@ -1,14 +0,0 @@ - - - - - - -

-
- Read More... -

- - - - diff --git a/extra/webapps/wiki/initial-content/Farkup.txt b/extra/webapps/wiki/initial-content/Farkup.txt new file mode 100644 index 0000000000..8814af6c0a --- /dev/null +++ b/extra/webapps/wiki/initial-content/Farkup.txt @@ -0,0 +1,63 @@ +Look at the source to this page by clicking *Edit* to compare the farkup language with resulting output. + += level 1 heading = + +== level 2 heading == + +=== level 3 heading === + +==== level 4 heading ==== + +Here is a paragraph of text, with _emphasized_ and *strong* text, together with an inline %code snippet%. Did you know that E=mc^2^, and L~2~ spaces are cool? Of course, if you want to include \_ special \* characters \^ you \~ can \% do that, too. + +You can make [[Wiki Links]] just like that, as well as links to external sites: [[http://sbcl.sourceforge.net]]. [[Factor|Custom link text]] can be used [[http://www.apple.com|with both types of links]]. + +Images can be embedded in the text: + +[[image:http://factorcode.org/graphics/logo.png]] + +- a list +- with three +- items + +|a table|with|four|columns| +|and|two|rows|...| + +Here is some code: + +[{HAI +CAN HAS STDIO? +VISIBLE "HAI WORLD!" +KTHXBYE}] + +There is syntax highlighting various languages, too: + +[factor{PEG: parse-request-line ( string -- triple ) + #! Triple is { method url version } + [ + 'space' , + 'http-method' , + 'space' , + 'url' , + 'space' , + 'http-version' , + 'space' , + ] seq* just ;}] + +Some Java: + +[java{/** + * Returns the extension of the specified filename, or an empty + * string if there is none. + * @param path The path + */ +public static String getFileExtension(String path) +{ + int fsIndex = getLastSeparatorIndex(path); + int index = path.lastIndexOf('.'); + // there could be a dot in the path and no file extension + if(index == -1 || index < fsIndex ) + return ""; + else + return path.substring(index); +}}] diff --git a/extra/webapps/wiki/initial-content/Front Page.txt b/extra/webapps/wiki/initial-content/Front Page.txt new file mode 100644 index 0000000000..37351eed38 --- /dev/null +++ b/extra/webapps/wiki/initial-content/Front Page.txt @@ -0,0 +1,5 @@ +Congratulations, you are now running your very own Wiki. + +You can now click *Edit* below and begin editing the content of the [[Front Page]]. This Wiki uses [[Farkup]] to mark up text. + +Two special article names are recognized by the Wiki: [[Sidebar]] and [[Footer]]. They do not exist by default, but if you create them, they will be visible on every page. diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml index 0abd36a7cd..5cddcee628 100644 --- a/extra/webapps/wiki/wiki-common.xml +++ b/extra/webapps/wiki/wiki-common.xml @@ -13,6 +13,7 @@ Front Page | All Articles | Recent Changes + | Random Article @@ -45,6 +46,16 @@ + + + + + + + + + + diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index 77ee242668..3c87f3cd49 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel hashtables calendar +USING: accessors kernel hashtables calendar random assocs namespaces splitting sequences sorting math.order present +io.files io.encodings.ascii syndication html.components html.forms http.server @@ -115,6 +116,14 @@ M: revision feed-entry-url id>> revision-url ; { wiki "view" } >>template ; +: ( -- action ) + + [ + article new select-tuples random + [ title>> ] [ "Front Page" ] if* + view-url + ] >>display ; + : amend-article ( revision article -- ) swap id>> >>revision update-tuple ; @@ -286,15 +295,15 @@ M: revision feed-entry-url id>> revision-url ; { wiki "page-common" } >>template ; : init-sidebar ( -- ) - "Sidebar" latest-revision [ - "sidebar" [ from-object ] nest-form - ] when* ; + "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when* + "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ; : ( -- dispatcher ) wiki new-dispatcher "" add-responder "view" add-responder "revision" add-responder + "random" add-responder "revisions" add-responder "revisions.atom" add-responder "diff" add-responder @@ -309,3 +318,15 @@ M: revision feed-entry-url id>> revision-url ; [ init-sidebar ] >>init { wiki "wiki-common" } >>template ; + +: init-wiki ( -- ) + "resource:extra/webapps/wiki/initial-content" directory* keys + [ + [ ascii file-contents ] [ file-name "." split1 drop ] bi + f + swap >>title + swap >>content + "slava" >>author + now >>date + add-revision + ] each ; diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 211dcb3c11..1ae7f63a27 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -25,7 +25,7 @@ webapps.wee-url webapps.user-admin ; IN: websites.concatenative -: test-db ( -- db params ) "resource:test.db" sqlite-db ; +: test-db ( -- params db ) "resource:test.db" sqlite-db ; : init-factor-db ( -- ) test-db [ From 1a32ffafa389a9769e7d96ce1f7e599247fef280 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 8 Jul 2008 22:58:34 -0500 Subject: [PATCH 7/9] bake: work with strings --- extra/bake/bake.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 4ce7bfb586..bcb7c2238f 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,6 +1,6 @@ USING: kernel parser namespaces sequences quotations arrays vectors splitting - words math + strings words math macros arrays.lib combinators.lib combinators.conditional newfx ; IN: bake @@ -20,7 +20,9 @@ DEFER: [bake] : broil-element ( obj -- quot ) { { [ comma? ] [ drop [ >r ] ] } + { [ f = ] [ [ >r ] prefix-on ] } { [ integer? ] [ [ >r ] prefix-on ] } + { [ string? ] [ [ >r ] prefix-on ] } { [ sequence? ] [ [bake] [ >r ] append ] } { [ word? ] [ literalize [ >r ] prefix-on ] } { [ drop t ] [ [ >r ] prefix-on ] } From 2c8866c1394621df946af41da99e8802a1c89632 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 8 Jul 2008 23:08:12 -0500 Subject: [PATCH 8/9] documents: move from delegation to inheritance --- extra/documents/documents.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor index 9e4802c2ef..d046102ec9 100755 --- a/extra/documents/documents.factor +++ b/extra/documents/documents.factor @@ -15,11 +15,11 @@ IN: documents : lines-equal? ( loc1 loc2 -- ? ) [ first ] bi@ number= ; -TUPLE: document locs ; +TUPLE: document < model locs ; : ( -- document ) - V{ "" } clone V{ } clone - { set-delegate set-document-locs } document construct ; + V{ "" } clone document new-model + V{ } clone >>locs ; : add-loc ( loc document -- ) locs>> push ; From b8d9379b2bc42cef6c7e9910a57bb44a792f73c8 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 9 Jul 2008 12:22:07 -0500 Subject: [PATCH 9/9] bake and bake.fry: `[ == bake quotation '[ == fry quotation --- extra/bake/bake.factor | 3 ++- extra/bake/fry/fry-tests.factor | 42 ++++++++++++++++----------------- extra/bake/fry/fry.factor | 2 +- 3 files changed, 24 insertions(+), 23 deletions(-) diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 0834c84c9a..748a811b34 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -92,5 +92,6 @@ MACRO: bake ( seq -- quot ) [bake] ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing +: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing : `V{ \ } [ >vector ] parse-literal \ bake parsed ; parsing +: `[ \ } [ >quotation ] parse-literal \ bake parsed ; parsing \ No newline at end of file diff --git a/extra/bake/fry/fry-tests.factor b/extra/bake/fry/fry-tests.factor index 13202a78f5..74408dc9f9 100755 --- a/extra/bake/fry/fry-tests.factor +++ b/extra/bake/fry/fry-tests.factor @@ -13,74 +13,74 @@ IN: bake.fry.tests ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -[ [ 3 + ] ] [ 3 `[ , + ] ] unit-test +[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test -[ [ 1 3 + ] ] [ 1 3 `[ , , + ] ] unit-test +[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test -[ [ 1 + ] ] [ 1 [ + ] `[ , @ ] ] unit-test +[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test -[ [ 1 + . ] ] [ 1 [ + ] `[ , @ . ] ] unit-test +[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test -[ [ + - ] ] [ [ + ] [ - ] `[ @ @ ] ] unit-test +[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test [ [ "a" write "b" print ] ] -[ "a" "b" `[ , write , print ] ] unit-test +[ "a" "b" '[ , write , print ] ] unit-test [ [ 1 2 + 3 4 - ] ] -[ [ + ] [ - ] `[ 1 2 @ 3 4 @ ] ] unit-test +[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test [ 1/2 ] [ - 1 `[ , _ / ] 2 swap call + 1 '[ , _ / ] 2 swap call ] unit-test [ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [ - 1 `[ , _ _ 3array ] + 1 '[ , _ _ 3array ] { "a" "b" "c" } { "A" "B" "C" } rot 2map ] unit-test [ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [ - `[ 1 _ 2array ] + '[ 1 _ 2array ] { "a" "b" "c" } swap map ] unit-test [ 1 2 ] [ - 1 2 `[ _ , ] call + 1 2 '[ _ , ] call ] unit-test [ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [ - 1 2 `[ , _ , 3array ] + 1 2 '[ , _ , 3array ] { "a" "b" "c" } swap map ] unit-test -: funny-dip `[ @ _ ] call ; inline +: funny-dip '[ @ _ ] call ; inline [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test [ { 1 2 3 } ] [ - 3 1 `[ , [ , + ] map ] call + 3 1 '[ , [ , + ] map ] call ] unit-test [ { 1 { 2 { 3 } } } ] [ - 1 2 3 `[ , [ , [ , 1array ] call 2array ] call 2array ] call + 1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call ] unit-test -{ 1 1 } [ `[ [ [ , ] ] ] ] must-infer-as +{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as [ { { { 3 } } } ] [ - 3 `[ [ [ , 1array ] call 1array ] call 1array ] call + 3 '[ [ [ , 1array ] call 1array ] call 1array ] call ] unit-test [ { { { 3 } } } ] [ - 3 `[ [ [ , 1array ] call 1array ] call 1array ] call + 3 '[ [ [ , 1array ] call 1array ] call 1array ] call ] unit-test -! [ 10 20 30 40 `[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test* +! [ 10 20 30 40 '[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test* -[ 10 20 30 40 `[ , V{ , { , } } , ] ] +[ 10 20 30 40 '[ , V{ , { , } } , ] ] [ [ 10 20 30 >r r> 1 narray >r >r r> r> 2 narray >vector 40 ] ] unit-test* -[ { 1 2 3 } { 4 5 6 } { 7 8 9 } `[ , { V{ @ } { , } } ] call ] +[ { 1 2 3 } { 4 5 6 } { 7 8 9 } '[ , { V{ @ } { , } } ] call ] [ { 1 2 3 } { V{ 4 5 6 } { { 7 8 9 } } } diff --git a/extra/bake/fry/fry.factor b/extra/bake/fry/fry.factor index 6b069334e6..b9f9882e88 100644 --- a/extra/bake/fry/fry.factor +++ b/extra/bake/fry/fry.factor @@ -77,4 +77,4 @@ DEFER: shallow-fry MACRO: fry ( seq -- quot ) [fry] ; -: `[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing \ No newline at end of file +: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing \ No newline at end of file