Merge branch 'master' of git://factorcode.org/git/factor

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 } }

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 ;

basis/tools/annotations/annotations.factor

@@ -9,8 +9,7 @@ IN: tools.annotations
 GENERIC: reset ( word -- )
 
 M: generic reset
-    [ call-next-method ]
+    subwords [ reset ] each ;
-    [ subwords [ reset ] each ] bi ;
 
 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" ;
+
 <PRIVATE
 
 : check-annotate-twice ( word -- word )
@@ -29,17 +30,19 @@ ERROR: cannot-annotate-twice word ;
         cannot-annotate-twice
     ] when ;
 
-: save-unannotated-def ( word -- )
-    dup def>> "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 ;
 
 <PRIVATE
 
@@ -77,19 +80,11 @@ PRIVATE>
 : 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
 

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

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
+    [ -8 shift BIN: 11011000 bitor ] [ HEX: FF bitand ] bi ;
-    swap HEX: FF bitand ;
 
 : encode-second ( char -- byte3 byte4 )
     BIN: 1111111111 bitand
-    dup -8 shift BIN: 11011100 bitor
+    [ -8 shift BIN: 11011100 bitor ] [ BIN: 11111111 bitand ] bi ;
-    swap BIN: 11111111 bitand ;
 
-: stream-write2 ( stream char1 char2 -- )
+: stream-write2 ( char1 char2 stream -- )
-    rot [ stream-write1 ] curry bi@ ;
+    [ stream-write1 ] curry bi@ ;
 
-: char>utf16be ( stream char -- )
+: char>utf16be ( char stream -- )
-    dup HEX: FFFF > [
+    over HEX: FFFF > [
-        HEX: 10000 -
+        [ HEX: 10000 - ] dip
-        2dup encode-first stream-write2
+        [ [ encode-first ] dip stream-write2 ]
-        encode-second stream-write2
+        [ [ encode-second ] dip stream-write2 ] 2bi
-    ] [ h>b/b swap stream-write2 ] if ;
+    ] [ [ 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 -- )
+: char>utf16le ( stream char -- )
-    dup HEX: FFFF > [
+    over HEX: FFFF > [
-        HEX: 10000 -
+        [ HEX: 10000 - ] dip
-        2dup encode-first swap stream-write2
+        [ [ encode-first swap ] dip stream-write2 ]
-        encode-second swap stream-write2
+        [ [ encode-second swap ] dip stream-write2 ] 2bi
-    ] [ h>b/b stream-write2 ] if ; 
+    ] [ [ h>b/b ] dip stream-write2 ] if ; 
 
 M: utf16le encode-char ( char stream encoding -- )
-    drop swap char>utf16le ;
+    drop char>utf16le ;
 
 ! UTF-16
 

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 ]

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>
 

extra/webapps/planet/planet.factor

@@ -166,9 +166,7 @@ posting "POSTINGS"
         [
             f <blog>
             [ deposit-blog-slots ]
-            [ "id" value >>id ]
+            [ "id" value >>id update-tuple ] bi
-            [ update-tuple ]
-            tri
 
             <url>
                 "$planet/admin" >>path