From d44216735484cc6259e6a7f78955522621322c90 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 May 2009 19:36:52 -0500 Subject: [PATCH 1/6] tools.annotations: work better on generic words --- .../tools/annotations/annotations-docs.factor | 5 --- .../annotations/annotations-tests.factor | 3 ++ basis/tools/annotations/annotations.factor | 35 ++++++++----------- 3 files changed, 18 insertions(+), 25 deletions(-) diff --git a/basis/tools/annotations/annotations-docs.factor b/basis/tools/annotations/annotations-docs.factor index 005f5f7af8..8d73d85fb5 100644 --- a/basis/tools/annotations/annotations-docs.factor +++ b/basis/tools/annotations/annotations-docs.factor @@ -39,11 +39,6 @@ HELP: breakpoint-if { $values { "quot" { $quotation "( -- ? )" } } { "word" word } } { $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ; -HELP: annotate-methods -{ $values - { "word" word } { "quot" quotation } } -{ $description "Annotates the word -- for generic words, all its methods -- with the quotation." } ; - HELP: reset { $values { "word" word } } diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor index bbd2ac2ca8..c312b54edb 100644 --- a/basis/tools/annotations/annotations-tests.factor +++ b/basis/tools/annotations/annotations-tests.factor @@ -39,6 +39,9 @@ M: object another-generic ; [ "" ] [ [ 3 another-generic drop ] with-string-writer ] unit-test +! reset should do the right thing for generic words +[ ] [ \ another-generic watch ] unit-test + GENERIC: blah-generic ( a -- b ) M: string blah-generic ; diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index 3cb74fb00b..3aac371a6a 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -9,8 +9,7 @@ IN: tools.annotations GENERIC: reset ( word -- ) M: generic reset - [ call-next-method ] - [ subwords [ reset ] each ] bi ; + subwords [ reset ] each ; M: word reset dup "unannotated-def" word-prop [ @@ -22,6 +21,8 @@ M: word reset ERROR: cannot-annotate-twice word ; +M: cannot-annotate-twice summary drop "Cannot annotate a word twice" ; + > "unannotated-def" set-word-prop ; - -: (annotate) ( word quot -- ) - [ dup def>> ] dip call( old -- new ) define ; - PRIVATE> -: annotate ( word quot -- ) +GENERIC# annotate 1 ( word quot -- ) + +M: generic annotate + [ "methods" word-prop values ] dip '[ _ annotate ] each ; + +M: word annotate [ check-annotate-twice ] dip - [ over save-unannotated-def (annotate) ] with-compilation-unit ; + [ + [ dup def>> 2dup "unannotated-def" set-word-prop ] dip + call( old -- new ) define + ] with-compilation-unit ; : watch-vars ( word vars -- ) dupd '[ [ _ _ ] dip (watch-vars) ] annotate ; -GENERIC# annotate-methods 1 ( word quot -- ) - -M: generic annotate-methods - [ "methods" word-prop values ] dip [ annotate ] curry each ; - -M: word annotate-methods - annotate ; - : breakpoint ( word -- ) - [ add-breakpoint ] annotate-methods ; + [ add-breakpoint ] annotate ; : breakpoint-if ( word quot -- ) - '[ [ _ [ [ break ] when ] ] dip 3append ] annotate-methods ; + '[ [ _ [ [ break ] when ] ] dip 3append ] annotate ; SYMBOL: word-timing From a4b2fa2aeb2cb90e0ece2b5b2eed8c1273930ba8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 May 2009 19:37:03 -0500 Subject: [PATCH 2/6] destructors: improve docs --- core/destructors/destructors-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/destructors/destructors-docs.factor b/core/destructors/destructors-docs.factor index 0b6ca15f31..536ee19c8b 100644 --- a/core/destructors/destructors-docs.factor +++ b/core/destructors/destructors-docs.factor @@ -26,7 +26,7 @@ HELP: with-disposal HELP: with-destructors { $values { "quot" "a quotation" } } -{ $description "Calls a quotation within a new dynamic scope. This quotation may register destructors, on any object, by wrapping the object in a destructor and implementing " { $link dispose } " on that object type. After the quotation finishes, if an error was thrown, all destructors are called and the error is then rethrown. However, if the quotation was successful, only those destructors created with an 'always cleanup' flag will be destroyed." } +{ $description "Calls a quotation within a new dynamic scope. This quotation may register destructors using " { $link &dispose } " or " { $link |dispose } ". The former registers a destructor that will always run whether or not the quotation threw an error, and the latter registers a destructor that only runs if the quotation throws an error only. Destructors are run in reverse order from the order in which they were registered." } { $notes "Destructors generalize " { $link with-disposal } ". The following two lines are equivalent, except that the second line establishes a new dynamic scope:" { $code From 430b1f50b9a0ac45aa3d7f651f33a376450ee60c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 May 2009 19:37:12 -0500 Subject: [PATCH 3/6] webapps.planet: fix edit-blog action --- extra/webapps/planet/planet.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 52d64f0f9e..12b7ccda24 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -166,9 +166,7 @@ posting "POSTINGS" [ f [ deposit-blog-slots ] - [ "id" value >>id ] - [ update-tuple ] - tri + [ "id" value >>id update-tuple ] bi "$planet/admin" >>path From ef73bc67321f5fa59aafc8f5c12a01f3a90a4ab0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 May 2009 02:50:57 -0500 Subject: [PATCH 4/6] io.encodings.utf16: cleanup --- core/io/encodings/utf16/utf16.factor | 40 +++++++++++++--------------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index a6ccc95bf5..1fb5ad1116 100644 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -59,7 +59,7 @@ M: utf16be decode-char ] [ append-nums ] if ; : begin-utf16le ( stream byte -- stream char ) - over stream-read1 [ double-le ] [ drop replacement-char ] if* ; + over stream-read1 dup [ double-le ] [ 2drop replacement-char ] if ; M: utf16le decode-char drop dup stream-read1 dup [ begin-utf16le ] when nip ; @@ -68,36 +68,34 @@ M: utf16le decode-char : encode-first ( char -- byte1 byte2 ) -10 shift - dup -8 shift BIN: 11011000 bitor - swap HEX: FF bitand ; + [ -8 shift BIN: 11011000 bitor ] [ HEX: FF bitand ] bi ; : encode-second ( char -- byte3 byte4 ) BIN: 1111111111 bitand - dup -8 shift BIN: 11011100 bitor - swap BIN: 11111111 bitand ; + [ -8 shift BIN: 11011100 bitor ] [ BIN: 11111111 bitand ] bi ; -: stream-write2 ( stream char1 char2 -- ) - rot [ stream-write1 ] curry bi@ ; +: stream-write2 ( char1 char2 stream -- ) + [ stream-write1 ] curry bi@ ; -: char>utf16be ( stream char -- ) - dup HEX: FFFF > [ - HEX: 10000 - - 2dup encode-first stream-write2 - encode-second stream-write2 - ] [ h>b/b swap stream-write2 ] if ; +: char>utf16be ( char stream -- ) + over HEX: FFFF > [ + [ HEX: 10000 - ] dip + [ [ encode-first ] dip stream-write2 ] + [ [ encode-second ] dip stream-write2 ] 2bi + ] [ [ h>b/b swap ] dip stream-write2 ] if ; M: utf16be encode-char ( char stream encoding -- ) - drop swap char>utf16be ; + drop char>utf16be ; -: char>utf16le ( char stream -- ) - dup HEX: FFFF > [ - HEX: 10000 - - 2dup encode-first swap stream-write2 - encode-second swap stream-write2 - ] [ h>b/b stream-write2 ] if ; +: char>utf16le ( stream char -- ) + over HEX: FFFF > [ + [ HEX: 10000 - ] dip + [ [ encode-first swap ] dip stream-write2 ] + [ [ encode-second swap ] dip stream-write2 ] 2bi + ] [ [ h>b/b ] dip stream-write2 ] if ; M: utf16le encode-char ( char stream encoding -- ) - drop swap char>utf16le ; + drop char>utf16le ; ! UTF-16 From 0dffd311a530f9f6c53619bf0418613ab9c73ede Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 May 2009 02:52:05 -0500 Subject: [PATCH 5/6] descriptive: update for tools.annotations change --- extra/descriptive/descriptive.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index 9af94aa4ed..0756c5c975 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -28,7 +28,7 @@ PRIVATE> : make-descriptive ( word -- ) dup [ ] [ def>> ] [ stack-effect ] tri [descriptive] - '[ drop _ ] annotate-methods ; + '[ drop _ ] annotate ; : define-descriptive ( word def effect -- ) [ drop "descriptive-definition" set-word-prop ] From 3ffb67742f74f1e320fbba817a492229f4ba0cd2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 29 May 2009 05:37:48 -0500 Subject: [PATCH 6/6] fuel.xref: remove some unnecessary inlines --- extra/fuel/xref/xref.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor index 3e3279ece7..608667bae7 100644 --- a/extra/fuel/xref/xref.factor +++ b/extra/fuel/xref/xref.factor @@ -23,13 +23,13 @@ IN: fuel.xref dup dup >vocab-link where normalize-loc 4array ; : sort-xrefs ( seq -- seq' ) - [ [ first ] dip first <=> ] sort ; inline + [ [ first ] dip first <=> ] sort ; : format-xrefs ( seq -- seq' ) - [ word? ] filter [ word>xref ] map ; inline + [ word? ] filter [ word>xref ] map ; : filter-prefix ( seq prefix -- seq ) - [ drop-prefix nip length 0 = ] curry filter prune ; inline + [ drop-prefix nip length 0 = ] curry filter prune ; MEMO: (vocab-words) ( name -- seq ) >vocab-link words [ name>> ] map ; @@ -37,10 +37,10 @@ MEMO: (vocab-words) ( name -- seq ) : current-words ( -- seq ) manifest get [ search-vocabs>> ] [ qualified-vocabs>> ] bi [ words>> ] bi@ - assoc-union keys ; inline + assoc-union keys ; : vocabs-words ( names -- seq ) - prune [ (vocab-words) ] map concat ; inline + prune [ (vocab-words) ] map concat ; PRIVATE>