Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32

basis/alien/c-types/c-types-tests.factor

@@ -4,7 +4,7 @@ sequences system libc alien.strings io.encodings.utf8 ;
 
 \ expand-constants must-infer
 
-: xyz 123 ;
+CONSTANT: xyz 123
 
 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
 

basis/alien/structs/fields/fields.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel kernel.private math namespaces
 make sequences strings words effects combinators alien.c-types ;
@@ -6,28 +6,6 @@ IN: alien.structs.fields
 
 TUPLE: field-spec name offset type reader writer ;
 
-: reader-effect ( type spec -- effect )
-    [ 1array ] [ name>> 1array ] bi* <effect> ;
-
-PREDICATE: slot-reader < word "reading" word-prop >boolean ;
-
-: set-reader-props ( class spec -- )
-    2dup reader-effect
-    over reader>>
-    swap "declared-effect" set-word-prop
-    reader>> swap "reading" set-word-prop ;
-
-: writer-effect ( type spec -- effect )
-    name>> swap 2array 0 <effect> ;
-
-PREDICATE: slot-writer < word "writing" word-prop >boolean ;
-
-: set-writer-props ( class spec -- )
-    2dup writer-effect
-    over writer>>
-    swap "declared-effect" set-word-prop
-    writer>> swap "writing" set-word-prop ;
-
 : reader-word ( class name vocab -- word )
     [ "-" glue ] dip create ;
 
@@ -55,17 +33,13 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
 : define-struct-slot-word ( word quot spec effect -- )
     [ offset>> prefix ] dip define-inline ;
 
-: define-getter ( type spec -- )
+: define-getter ( spec -- )
-    [ set-reader-props ] keep
+    [ reader>> ] [ type>> c-type-getter-boxer ] [ ] tri
-    [ reader>> ]
-    [ type>> c-type-getter-boxer ]
-    [ ] tri
     (( c-ptr -- value )) define-struct-slot-word ;
 
-: define-setter ( type spec -- )
+: define-setter ( spec -- )
-    [ set-writer-props ] keep
     [ writer>> ] [ type>> c-setter ] [ ] tri
     (( value c-ptr -- )) define-struct-slot-word ;
 
-: define-field ( type spec -- )
+: define-field ( spec -- )
-    [ define-getter ] [ define-setter ] 2bi ;
+    [ define-getter ] [ define-setter ] bi ;

basis/alien/structs/structs-tests.factor

@@ -24,7 +24,7 @@ os winnt? cpu x86? and [
     ] when
 ] when
 
-: MAX_FOOS 30 ;
+CONSTANT: MAX_FOOS 30
 
 C-STRUCT: foox
     { { "int" MAX_FOOS } "x" } ;

basis/alien/structs/structs.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
@@ -56,10 +56,10 @@ M: struct-type stack-size
 : (define-struct) ( name size align fields -- )
     [ [ align ] keep ] dip
     struct-type new
-    swap >>fields
+        swap >>fields
-    swap >>align
+        swap >>align
-    swap >>size
+        swap >>size
-    swap typedef ;
+        swap typedef ;
 
 : make-fields ( name vocab fields -- fields )
     [ first2 <field-spec> ] with with map ;
@@ -68,12 +68,11 @@ M: struct-type stack-size
     [ c-type-align ] [ max ] map-reduce ;
 
 : define-struct ( name vocab fields -- )
-    [
+    [ 2drop ] [ make-fields ] 3bi
-        [ 2drop ] [ make-fields ] 3bi
+    [ struct-offsets ] keep
-        [ struct-offsets ] keep
+    [ [ type>> ] map compute-struct-align ] keep
-        [ [ type>> ] map compute-struct-align ] keep
+    [ (define-struct) ] keep
-        [ (define-struct) ] keep
+    [ define-field ] each ;
-    ] [ 2drop '[ _ swap define-field ] ] 3bi each ;
 
 : define-union ( name members -- )
     [ expand-constants ] map
@@ -83,4 +82,3 @@ M: struct-type stack-size
 : offset-of ( field struct -- offset )
     c-types get at fields>> 
     [ name>> = ] with find nip offset>> ;
-

basis/bit-vectors/bit-vectors-tests.factor

@@ -3,7 +3,7 @@ USING: tools.test bit-vectors vectors sequences kernel math ;
 
 [ 0 ] [ 123 <bit-vector> length ] unit-test
 
-: do-it
+: do-it ( seq -- )
     1234 swap [ [ even? ] dip push ] curry each ;
 
 [ t ] [

basis/bootstrap/help/help.factor

@@ -5,7 +5,7 @@ IN: bootstrap.help
 
 : load-help ( -- )
     "help.lint" require
-    "tools.vocabs.browser" require
+    "help.vocabs" require
     "alien.syntax" require
     "compiler" require
 

basis/bootstrap/image/image.factor

@@ -95,10 +95,10 @@ CONSTANT: -1-offset             9
 SYMBOL: sub-primitives
 
 : make-jit ( quot rc rt offset -- quad )
-    [ { } make ] 3dip 4array ; inline
+    [ [ call( -- ) ] { } make ] 3dip 4array ;
 
 : jit-define ( quot rc rt offset name -- )
-    [ make-jit ] dip set ; inline
+    [ make-jit ] dip set ;
 
 : define-sub-primitive ( quot rc rt offset word -- )
     [ make-jit ] dip sub-primitives get set-at ;
@@ -398,9 +398,14 @@ M: byte-array '
     ] emit-object ;
 
 ! Tuples
+ERROR: tuple-removed class ;
+
+: require-tuple-layout ( word -- layout )
+    dup tuple-layout [ ] [ tuple-removed ] ?if ;
+
 : (emit-tuple) ( tuple -- pointer )
     [ tuple-slots ]
-    [ class transfer-word tuple-layout ] bi prefix [ ' ] map
+    [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
     tuple type-number dup [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )

basis/bootstrap/tools/tools.factor

@@ -14,7 +14,6 @@ IN: bootstrap.tools
     "tools.time"
     "tools.threads"
     "tools.vocabs"
-    "tools.vocabs.browser"
     "tools.vocabs.monitor"
     "editors"
 } [ require ] each

basis/byte-vectors/byte-vectors-tests.factor

@@ -4,7 +4,7 @@ prettyprint ;
 
 [ 0 ] [ 123 <byte-vector> length ] unit-test
 
-: do-it
+: do-it ( seq -- seq )
     123 [ over push ] each ;
 
 [ t ] [

basis/calendar/calendar-tests.factor

@@ -148,7 +148,7 @@ IN: calendar.tests
 [ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
 [ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
 
-: checktime+ now dup clone [ rot time+ drop ] keep = ;
+: checktime+ ( duration -- ? ) now dup clone [ rot time+ drop ] keep = ;
 
 [ t ] [ 5 seconds checktime+ ] unit-test
 

basis/calendar/format/format.factor

@@ -46,6 +46,11 @@ IN: calendar.format
 
 : read-0000 ( -- n ) 4 read string>number ;
 
+: hhmm>timestamp ( hhmm -- timestamp )
+    [
+        0 0 0 read-00 read-00 0 instant <timestamp>
+    ] with-string-reader ;
+
 GENERIC: day. ( obj -- )
 
 M: integer day. ( n -- )

basis/cocoa/cocoa-tests.factor

@@ -13,7 +13,7 @@ CLASS: {
     [ gc "x" set 2drop ]
 } ;
 
-: test-foo
+: test-foo ( -- )
     Foo -> alloc -> init
     dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
     -> release ;

basis/cocoa/messages/messages.factor

@@ -22,15 +22,13 @@ SYMBOL: super-message-senders
 message-senders [ H{ } clone ] initialize
 super-message-senders [ H{ } clone ] initialize
 
-: cache-stub ( method function hash -- )
+: cache-stub ( method assoc function -- )
-    [
+    '[ _ sender-stub ] cache drop ;
-        over get [ 2drop ] [ over [ sender-stub ] dip set ] if
-    ] bind ;
 
 : cache-stubs ( method -- )
-    dup
+    [ super-message-senders get "objc_msgSendSuper" cache-stub ]
-    "objc_msgSendSuper" super-message-senders get cache-stub
+    [ message-senders get "objc_msgSend" cache-stub ]
-    "objc_msgSend" message-senders get cache-stub ;
+    bi ;
 
 : <super> ( receiver -- super )
     "objc-super" <c-object> [

basis/cocoa/views/views.factor

@@ -89,4 +89,4 @@ PRIVATE>
         -> locationInWindow f -> convertPoint:fromView:
         [ CGPoint-x ] [ CGPoint-y ] bi
     ] [ drop -> frame CGRect-h ] 2bi
-    swap - 2array ;
+    swap - [ >integer ] bi@ 2array ;

basis/compiler/compiler.factor

@@ -35,11 +35,14 @@ SYMBOLS: +optimized+ +unoptimized+ ;
     [ usage [ word? ] filter ] [ compiled-usage keys ] if
     [ queue-compile ] each ;
 
-: ripple-up? ( word status -- ? )
+: ripple-up? ( status word -- ? )
-    swap "compiled-status" word-prop [ = not ] keep and ;
+    [
+        [ nip changed-effects get key? ]
+        [ "compiled-status" word-prop eq? not ] 2bi or
+    ] keep "compiled-status" word-prop and ;
 
 : save-compiled-status ( word status -- )
-    [ dupd ripple-up? [ ripple-up ] [ drop ] if ]
+    [ over ripple-up? [ ripple-up ] [ drop ] if ]
     [ "compiled-status" set-word-prop ]
     2bi ;
 

basis/compiler/tests/intrinsics.factor

@@ -270,7 +270,7 @@ cell 8 = [
 ] when
 
 ! Some randomized tests
-: compiled-fixnum* fixnum* ;
+: compiled-fixnum* ( a b -- c ) fixnum* ;
 
 [ ] [
     10000 [ 
@@ -281,7 +281,7 @@ cell 8 = [
     ] times
 ] unit-test
 
-: compiled-fixnum>bignum fixnum>bignum ;
+: compiled-fixnum>bignum ( a -- b ) fixnum>bignum ;
 
 [ bignum ] [ 0 compiled-fixnum>bignum class ] unit-test
 
@@ -293,7 +293,7 @@ cell 8 = [
     ] times
 ] unit-test
 
-: compiled-bignum>fixnum bignum>fixnum ;
+: compiled-bignum>fixnum ( a -- b ) bignum>fixnum ;
 
 [ ] [
     10000 [

basis/compiler/tests/optimizer.factor

@@ -13,7 +13,7 @@ M: array xyz xyz ;
 [ t ] [ \ xyz optimized>> ] unit-test
 
 ! Test predicate inlining
-: pred-test-1
+: pred-test-1 ( a -- b c )
     dup fixnum? [
         dup integer? [ "integer" ] [ "nope" ] if
     ] [
@@ -24,7 +24,7 @@ M: array xyz xyz ;
 
 TUPLE: pred-test ;
 
-: pred-test-2
+: pred-test-2 ( a -- b c )
     dup tuple? [
         dup pred-test? [ "pred-test" ] [ "nope" ] if
     ] [
@@ -33,7 +33,7 @@ TUPLE: pred-test ;
 
 [ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-2 ] unit-test
 
-: pred-test-3
+: pred-test-3 ( a -- b c )
     dup pred-test? [
         dup tuple? [ "pred-test" ] [ "nope" ] if
     ] [
@@ -42,14 +42,14 @@ TUPLE: pred-test ;
 
 [ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test
 
-: inline-test
+: inline-test ( a -- b )
     "nom" = ;
 
 [ t ] [ "nom" inline-test ] unit-test
 [ f ] [ "shayin" inline-test ] unit-test
 [ f ] [ 3 inline-test ] unit-test
 
-: fixnum-declarations >fixnum 24 shift 1234 bitxor ;
+: fixnum-declarations ( a -- b ) >fixnum 24 shift 1234 bitxor ;
 
 [ ] [ 1000000 fixnum-declarations . ] unit-test
 
@@ -61,13 +61,13 @@ TUPLE: pred-test ;
 
 ! regression
 
-: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline
+: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline recursive
-: bad-kill-2 bad-kill-1 drop ;
+: bad-kill-2 ( a b -- c d ) bad-kill-1 drop ;
 
 [ 3 ] [ t bad-kill-2 ] unit-test
 
 ! regression
-: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline
+: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline recursive
 : the-test ( -- x y ) 2 dup (the-test) ;
 
 [ 2 0 ] [ the-test ] unit-test
@@ -77,7 +77,7 @@ TUPLE: pred-test ;
     < [
         6 1 (double-recursion)
         3 2 (double-recursion)
-    ] when ; inline
+    ] when ; inline recursive
 
 : double-recursion ( -- ) 0 2 (double-recursion) ;
 
@@ -85,7 +85,7 @@ TUPLE: pred-test ;
 
 ! regression
 : double-label-1 ( a b c -- d )
-    [ f double-label-1 ] [ swap nth-unsafe ] if ; inline
+    [ f double-label-1 ] [ swap nth-unsafe ] if ; inline recursive
 
 : double-label-2 ( a -- b )
     dup array? [ ] [ ] if 0 t double-label-1 ;
@@ -100,7 +100,7 @@ GENERIC: void-generic ( obj -- * )
 
 ! regression
 : branch-fold-regression-0 ( m -- n )
-    t [ ] [ 1+ branch-fold-regression-0 ] if ; inline
+    t [ ] [ 1+ branch-fold-regression-0 ] if ; inline recursive
 
 : branch-fold-regression-1 ( -- m )
     10 branch-fold-regression-0 ;
@@ -224,7 +224,7 @@ USE: binary-search.private
 ] unit-test
 
 ! Regression
-: empty-compound ;
+: empty-compound ( -- ) ;
 
 : node-successor-f-bug ( x -- * )
     [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
@@ -293,7 +293,7 @@ HINTS: recursive-inline-hang-3 array ;
 
 ! Wow
 : counter-example ( a b c d -- a' b' c' d' )
-    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline
+    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline recursive
 
 : counter-example' ( -- a' b' c' d' )
     1 2 3.0 3 counter-example ;

basis/compiler/tests/redefine15.factor

@@ -0,0 +1,20 @@
+USING: compiler.units words tools.test math kernel ;
+IN: compiler.tests.redefine15
+
+DEFER: word-1
+
+: word-2 ( a -- b ) word-1 ;
+
+[ \ word-1 [ ] (( a -- b )) define-declared ] with-compilation-unit 
+
+[ "a" ] [ "a" word-2 ] unit-test
+
+: word-3 ( a -- b ) 1 + ;
+
+: word-4 ( a -- b c ) 0 swap word-3 swap 1+ ;
+
+[ 1 1 ] [ 0 word-4 ] unit-test
+
+[ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit
+
+[ 2 3 ] [ 0 word-4 ] unit-test

basis/compiler/tests/redefine2.factor

@@ -1,12 +1,14 @@
 IN: compiler.tests
 USING: compiler compiler.units tools.test math parser kernel
 sequences sequences.private classes.mixin generic definitions
-arrays words assocs eval ;
+arrays words assocs eval words.symbol ;
 
 DEFER: redefine2-test
 
 [ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test
 
+[ t ] [ \ redefine2-test symbol? ] unit-test
+
 [ t ] [ redefine2-test new sequence? ] unit-test
 
 [ 3 ] [ 0 redefine2-test new nth-unsafe ] unit-test

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -90,7 +90,7 @@ M: object xyz ;
         [ swap [ call 1+ ] dip ] keep (i-repeat)
     ] if ; inline recursive
 
-: i-repeat [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
+: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
 
 [ t ] [
     [ [ dup xyz drop ] i-repeat ] \ xyz inlined?
@@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ;
         [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2)
     ] if ; inline recursive
 
-: annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline
+: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline
 
 [ f ] [
     [ { bignum } declare annotate-entry-test-2 ]

basis/constructors/constructors.factor

@@ -18,6 +18,6 @@ MACRO: set-slots ( slots -- quot )
 
 SYNTAX: CONSTRUCTOR:
     scan-word [ name>> "<" ">" surround create-in ] keep
-    "(" expect ")" parse-effect
+    complete-effect
     parse-definition
     define-constructor ;

basis/cpu/ppc/bootstrap.factor

@@ -11,8 +11,8 @@ big-endian on
 
 4 jit-code-format set
 
-: ds-reg 29 ;
+CONSTANT: ds-reg 29
-: rs-reg 30 ;
+CONSTANT: rs-reg 30
 
 : factor-area-size ( -- n ) 4 bootstrap-cells ;
 

basis/db/tuples/tuples-tests.factor

@@ -285,7 +285,7 @@ paste "PASTE"
 [ test-cascade ] test-postgresql
 [ test-restrict ] test-postgresql
 
-: test-repeated-insert
+: test-repeated-insert ( -- )
     [ ] [ person ensure-table ] unit-test
     [ ] [ person1 get insert-tuple ] unit-test
     [ person1 get insert-tuple ] must-fail ;
@@ -458,7 +458,7 @@ TUPLE: bignum-test id m n o ;
         swap >>n
         swap >>m ;
 
-: test-bignum
+: test-bignum ( -- )
     bignum-test "BIGNUM_TEST"
     {
         { "id" "ID" +db-assigned-id+ }
@@ -478,7 +478,7 @@ TUPLE: bignum-test id m n o ;
 TUPLE: secret n message ;
 C: <secret> secret
 
-: test-random-id
+: test-random-id ( -- )
     secret "SECRET"
     {
         { "n" "ID" +random-id+ system-random-generator }

basis/delegate/delegate-tests.factor

@@ -41,13 +41,13 @@ M: hello bing hello-test ;
 
 [ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" ] [ [ baz see ] with-string-writer ] unit-test
 
-GENERIC: one
+GENERIC: one ( a -- b )
 M: integer one ;
-GENERIC: two
+GENERIC: two ( a -- b )
 M: integer two ;
-GENERIC: three
+GENERIC: three ( a -- b )
 M: integer three ;
-GENERIC: four
+GENERIC: four ( a -- b )
 M: integer four ;
 
 PROTOCOL: alpha one two ;

basis/environment/environment-docs.factor

@@ -17,7 +17,7 @@ HELP: (set-os-envs)
 { $notes "In most cases, use " { $link set-os-envs } " instead." } ;
 
 
-HELP: os-env ( key -- value )
+HELP: os-env
 { $values { "key" string } { "value" string } }
 { $description "Looks up the value of a shell environment variable." }
 { $examples
@@ -39,14 +39,14 @@ HELP: set-os-envs
     "Names and values of environment variables are operating system-specific. Windows NT allows values up to 32766 characters in length."
 } ;
 
-HELP: set-os-env ( value key -- )
+HELP: set-os-env
 { $values { "value" string } { "key" string } }
 { $description "Set an environment variable." }
 { $notes
     "Names and values of environment variables are operating system-specific."
 } ;
 
-HELP: unset-os-env ( key -- )
+HELP: unset-os-env
 { $values { "key" string } }
 { $description "Unset an environment variable." }
 { $notes

basis/farkup/farkup-docs.factor

@@ -9,7 +9,7 @@ HELP: write-farkup
 { $values { "string" string } }
 { $description "Parse a Farkup string and writes the resulting HTML to " { $link output-stream } "." } ;
 
-HELP: parse-farkup ( string -- farkup )
+HELP: parse-farkup
 { $values { "string" string } { "farkup" "a Farkup syntax tree node" } }
 { $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;
 

basis/fry/fry-tests.factor

@@ -34,7 +34,7 @@ sequences eval accessors ;
     { "a" "b" "c" } swap map
 ] unit-test
 
-: funny-dip '[ [ @ ] dip ] call ; inline
+: funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline
 
 [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
 

basis/functors/functors-tests.factor

@@ -13,7 +13,7 @@ WHERE
 
 TUPLE: B { value T } ;
 
-C: <B> B
+C: <B> B ( T -- B )
 
 ;FUNCTOR
 

basis/functors/functors.factor

@@ -14,9 +14,9 @@ IN: functors
 
 : scan-param ( -- obj ) scan-object literalize ;
 
-: define* ( word def effect -- ) pick set-word define-declared ;
+: define* ( word def -- ) over set-word define ;
 
-: define-syntax* ( word def -- ) over set-word define-syntax ;
+: define-declared* ( word def effect -- ) pick set-word define-declared ;
 
 TUPLE: fake-quotation seq ;
 
@@ -41,7 +41,12 @@ M: object fake-quotations> ;
 : parse-definition* ( accum -- accum )
     parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
 
-: DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
+: parse-declared* ( accum -- accum )
+    complete-effect
+    [ parse-definition* ] dip
+    parsed ;
+
+: DEFINE* ( accum -- accum ) \ define-declared* parsed ;
 
 SYNTAX: `TUPLE:
     scan-param parsed
@@ -57,31 +62,28 @@ SYNTAX: `TUPLE:
     \ define-tuple-class parsed ;
 
 SYNTAX: `M:
-    effect off
     scan-param parsed
     scan-param parsed
     \ create-method-in parsed
     parse-definition*
-    DEFINE* ;
+    \ define* parsed ;
 
 SYNTAX: `C:
-    effect off
     scan-param parsed
     scan-param parsed
-    [ [ boa ] curry ] over push-all
+    complete-effect
-    DEFINE* ;
+    [ [ [ boa ] curry ] over push-all ] dip parsed
+    \ define-declared* parsed ;
 
 SYNTAX: `:
-    effect off
     scan-param parsed
-    parse-definition*
+    parse-declared*
-    DEFINE* ;
+    \ define-declared* parsed ;
 
 SYNTAX: `SYNTAX:
-    effect off
     scan-param parsed
     parse-definition*
-    \ define-syntax* parsed ;
+    \ define-syntax parsed ;
 
 SYNTAX: `INSTANCE:
     scan-param parsed
@@ -90,9 +92,6 @@ SYNTAX: `INSTANCE:
 
 SYNTAX: `inline [ word make-inline ] over push-all ;
 
-SYNTAX: `(
-    ")" parse-effect effect set ;
-
 : (INTERPOLATE) ( accum quot -- accum )
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
@@ -118,7 +117,6 @@ DEFER: ;FUNCTOR delimiter
         { "INSTANCE:" POSTPONE: `INSTANCE: }
         { "SYNTAX:" POSTPONE: `SYNTAX: }
         { "inline" POSTPONE: `inline }
-        { "(" POSTPONE: `( }
     } ;
 
 : push-functor-words ( -- )
@@ -133,9 +131,9 @@ DEFER: ;FUNCTOR delimiter
     [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) <let*> 1quotation
     pop-functor-words ;
 
-: (FUNCTOR:) ( -- word def )
+: (FUNCTOR:) ( -- word def effect )
     CREATE-WORD [ parse-functor-body ] parse-locals-definition ;
 
 PRIVATE>
 
-SYNTAX: FUNCTOR: (FUNCTOR:) define ;
+SYNTAX: FUNCTOR: (FUNCTOR:) define-declared ;

basis/furnace/actions/actions-tests.factor

@@ -7,7 +7,7 @@ IN: furnace.actions.tests
     [ "a" param "b" param [ string>number ] bi@ + ] >>display
 "action-1" set
 
-: lf>crlf "\n" split "\r\n" join ;
+: lf>crlf ( string -- string' ) "\n" split "\r\n" join ;
 
 STRING: action-request-test-1
 GET http://foo/bar?a=12&b=13 HTTP/1.1

basis/furnace/furnace-tests.factor

@@ -4,7 +4,7 @@ http.server furnace furnace.utilities tools.test kernel
 namespaces accessors io.streams.string urls xml.writer ;
 TUPLE: funny-dispatcher < dispatcher ;
 
-: <funny-dispatcher> funny-dispatcher new-dispatcher ;
+: <funny-dispatcher> ( -- dispatcher ) funny-dispatcher new-dispatcher ;
 
 TUPLE: base-path-check-responder ;
 

basis/furnace/sessions/sessions-tests.factor

@@ -6,7 +6,7 @@ io.streams.string io.files io.files.temp io.directories
 splitting destructors sequences db db.tuples db.sqlite
 continuations urls math.parser furnace furnace.utilities ;
 
-: with-session
+: with-session ( session quot -- )
     [
         [ [ save-session-after ] [ session set ] bi ] dip call
     ] with-destructors ; inline
@@ -22,7 +22,7 @@ M: foo call-responder*
     "x" [ 1+ ] schange
     "x" sget number>string "text/html" <content> ;
 
-: url-responder-mock-test
+: url-responder-mock-test ( -- )
     [
         <request>
             "GET" >>method
@@ -34,7 +34,7 @@ M: foo call-responder*
         [ write-response-body drop ] with-string-writer
     ] with-destructors ;
 
-: sessions-mock-test
+: sessions-mock-test ( -- )
     [
         <request>
             "GET" >>method
@@ -45,7 +45,7 @@ M: foo call-responder*
         [ write-response-body drop ] with-string-writer
     ] with-destructors ;
 
-: <exiting-action>
+: <exiting-action> ( -- action )
     <action>
         [ [ ] "text/plain" <content> exit-with ] >>display ;
 

basis/grouping/grouping-docs.factor

@@ -97,8 +97,7 @@ HELP: <clumps>
     { $example
         "USING: grouping sequences math prettyprint kernel ;"
         "IN: scratchpad"
-        ": share-price"
+        "CONSTANT: share-price { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 }"
-        "    { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
         ""
         "share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
         "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"

basis/hash2/hash2-tests.factor

@@ -4,7 +4,7 @@ IN: hash2.tests
 [ t ] [ 1 2 { 1 2 } 2= ] unit-test
 [ f ] [ 1 3 { 1 2 } 2= ] unit-test
 
-: sample-hash
+: sample-hash ( -- )
     5 <hash2>
     dup 2 3 "foo" roll set-hash2
     dup 4 2 "bar" roll set-hash2

basis/help/apropos/apropos-docs.factor

@@ -1,6 +1,8 @@
-IN: tools.apropos
+IN: help.apropos
-USING: help.markup help.syntax strings ;
+USING: help.markup help.syntax strings help.tips ;
 
 HELP: apropos
 { $values { "str" string } }
 { $description "Lists all words, vocabularies and help articles whose name contains a subsequence equal to " { $snippet "str" } ". Results are ranked using a simple distance algorithm." } ;
+
+TIP: "Use " { $link apropos } " to search for words, vocabularies and help articles." ;

basis/help/apropos/apropos-tests.factor

@@ -0,0 +1,4 @@
+IN: help.apropos.tests
+USING: help.apropos tools.test ;
+
+[ ] [ "swp" apropos ] unit-test

basis/help/apropos/apropos.factor

@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs fry help.markup help.topics io
 kernel make math math.parser namespaces sequences sorting
-summary tools.completion tools.vocabs tools.vocabs.browser
+summary tools.completion tools.vocabs help.vocabs
 vocabs words unicode.case help ;
-IN: tools.apropos
+IN: help.apropos
 
 : $completions ( seq -- )
     dup [ word? ] all? [ words-table ] [
@@ -67,5 +67,9 @@ M: apropos article-name article-title ;
 M: apropos article-content
     search>> 1array \ $apropos prefix ;
 
+M: apropos >link ;
+
+INSTANCE: apropos topic
+
 : apropos ( str -- )
     <apropos> print-topic ;

basis/help/cookbook/cookbook.factor

@@ -121,16 +121,16 @@ $nl
     "sequences"
 } ;
 
-ARTICLE: "cookbook-variables" "Variables cookbook"
+ARTICLE: "cookbook-variables" "Dynamic variables cookbook"
-"Before using a variable, you must define a symbol for it:"
-{ $code "SYMBOL: name" }
 "A symbol is a word which pushes itself on the stack when executed. Try it:"
 { $example "SYMBOL: foo" "foo ." "foo" }
+"Before using a variable, you must define a symbol for it:"
+{ $code "SYMBOL: name" }
 "Symbols can be passed to the " { $link get } " and " { $link set } " words to read and write variable values:"
-{ $example "\"Slava\" name set" "name get print" "Slava" }
+{ $unchecked-example "\"Slava\" name set" "name get print" "Slava" }
 "If you set variables inside a " { $link with-scope } ", their values will be lost after leaving the scope:"
-{ $example
+{ $unchecked-example
-    ": print-name name get print ;"
+    ": print-name ( -- ) name get print ;"
     "\"Slava\" name set"
     "["
     "    \"Diana\" name set"
@@ -139,11 +139,8 @@ ARTICLE: "cookbook-variables" "Variables cookbook"
     "\"Here, the name is \" write  print-name"
     "There, the name is Diana\nHere, the name is Slava"
 }
-{ $curious
-    "Variables are dynamically-scoped in Factor."
-}
 { $references
-    "There is a lot more to be said about variables and namespaces."
+    "There is a lot more to be said about dynamically-scoped variables and namespaces."
     "namespaces"
 } ;
 

basis/help/crossref/crossref-tests.factor

@@ -4,7 +4,7 @@ definitions assocs sequences kernel namespaces parser arrays
 io.streams.string continuations debugger compiler.units eval ;
 
 [ ] [
-    "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval
+    "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval
 ] unit-test
 
 [ $subsection ] [
@@ -23,7 +23,7 @@ io.streams.string continuations debugger compiler.units eval ;
 ] unit-test
 
 [ ] [
-    "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval
+    "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval
 ] unit-test
 
 [ ] [

basis/help/definitions/definitions-tests.factor

@@ -7,7 +7,7 @@ IN: help.definitions.tests
 
 [
     [ 4 ] [
-        "IN: help.definitions.tests USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
+        "IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
         parse-stream drop
 
         "foo" source-file definitions>> first assoc-size
@@ -20,7 +20,7 @@ IN: help.definitions.tests
     ] unit-test
 
     [ 2 ] [
-        "IN: help.definitions.tests USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
+        "IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
         parse-stream drop
 
         "foo" source-file definitions>> first assoc-size
@@ -32,7 +32,7 @@ IN: help.definitions.tests
         "hello" "help.definitions.tests" lookup "help" word-prop
     ] unit-test
 
-    [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ; HELP: xxx ;" eval ] unit-test
+    [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval ] unit-test
 
     [ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test
 

basis/help/handbook/handbook.factor

@@ -4,7 +4,7 @@ prettyprint.backend prettyprint.custom kernel.private io generic
 math system strings sbufs vectors byte-arrays quotations
 io.streams.byte-array classes.builtin parser lexer
 classes.predicate classes.union classes.intersection
-classes.singleton classes.tuple tools.vocabs.browser math.parser
+classes.singleton classes.tuple help.vocabs math.parser
 accessors ;
 IN: help.handbook
 
@@ -278,11 +278,7 @@ ARTICLE: "handbook-library-reference" "Library reference"
 "This index only includes articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "."
 { $index [ "handbook" orphan-articles remove ] } ;
 
-ARTICLE: "handbook" "Factor documentation"
+ARTICLE: "handbook" "Factor handbook"
-"Welcome to Factor."
-$nl
-"Explore the code base:"
-{ $subsection "vocab-index" }
 "Learn the language:"
 { $subsection "cookbook" }
 { $subsection "first-program" }
@@ -290,11 +286,13 @@ $nl
 { $subsection "handbook-environment-reference" }
 { $subsection "ui" }
 { $subsection "handbook-library-reference" }
-"The below indices only include articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "."
+"Explore loaded libraries:"
 { $subsection "article-index" }
 { $subsection "primitive-index" }
 { $subsection "error-index" }
 { $subsection "type-index" }
-{ $subsection "class-index" } ;
+{ $subsection "class-index" }
+"Explore the code base:"
+{ $subsection "vocab-index" } ;
 
 ABOUT: "handbook"

basis/help/help-docs.factor

@@ -127,6 +127,7 @@ ARTICLE: "help" "Help system"
 { $subsection "browsing-help" }
 { $subsection "writing-help" }
 { $subsection "help.lint" }
+{ $subsection "tips-of-the-day" }
 { $subsection "help-impl" } ;
 
 IN: help

basis/help/home/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/help/home/home-docs.factor

@@ -0,0 +1,19 @@
+IN: help.home
+USING: help.markup help.syntax ;
+
+ARTICLE: "help.home" "Factor documentation"
+{ $heading "Starting points" }
+{ $list
+  { $link "ui-listener" }
+  { $link "handbook" }
+  { $link "vocab-index" }
+}
+{ $heading "Recently visited" }
+{ $table
+  { "Words" "Articles" "Vocabs" }
+  { { $recent recent-words } { $recent recent-articles } { $recent recent-vocabs } }
+} print-element
+{ $heading "Recent searches" }
+{ $recent-searches } ;
+
+ABOUT: "help.home"

basis/help/home/home.factor

@@ -0,0 +1,40 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays compiler.units fry hashtables help.topics io
+kernel math namespaces sequences sets help.vocabs
+help.apropos vocabs help.markup ;
+IN: help.home
+
+SYMBOLS: recent-words recent-articles recent-vocabs recent-searches ;
+
+CONSTANT: recent-count 10
+
+{ recent-words recent-articles recent-vocabs recent-searches }
+[ [ V{ } clone ] initialize ] each
+
+GENERIC: add-recent-where ( obj -- obj symbol )
+
+M: link add-recent-where recent-articles ;
+M: word-link add-recent-where recent-words ;
+M: vocab-spec add-recent-where recent-vocabs ;
+M: apropos add-recent-where recent-searches ;
+M: object add-recent-where f ;
+
+: $recent ( element -- )
+    first get [ nl ] [ 1array $pretty-link ] interleave ;
+
+: $recent-searches ( element -- )
+    drop recent-searches get [ nl ] [ ($link) ] interleave ;
+
+: redisplay-recent-page ( -- )
+    "help.home" >link dup associate
+    notify-definition-observers ;
+
+: expire ( seq -- )
+    [ length recent-count - [ 0 > ] keep ] keep
+    '[ 0 _ _ delete-slice ] when ;
+
+: add-recent ( obj -- )
+    add-recent-where dup
+    [ get [ adjoin ] [ expire ] bi ] [ 2drop ] if
+    redisplay-recent-page ;

basis/help/html/html.factor

@@ -3,7 +3,7 @@
 USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
 io.files io.files.temp io.directories html.streams help kernel
 assocs sequences make words accessors arrays help.topics vocabs
-tools.vocabs tools.vocabs.browser namespaces prettyprint io
+tools.vocabs help.vocabs namespaces prettyprint io
 vocabs.loader serialize fry memoize unicode.case math.order
 sorting debugger html xml.syntax xml.writer ;
 IN: help.html

basis/help/markup/markup-tests.factor

@@ -11,7 +11,7 @@ TUPLE: blahblah quux ;
 [ ] [ \ >>quux print-topic ] unit-test
 [ ] [ \ blahblah? print-topic ] unit-test
 
-: fooey "fooey" throw ;
+: fooey ( -- * ) "fooey" throw ;
 
 [ ] [ \ fooey print-topic ] unit-test
 

basis/help/markup/markup.factor

@@ -4,7 +4,7 @@ USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots fry
 sets vocabs help.stylesheet help.topics vocabs.loader quotations
-combinators see ;
+combinators see present ;
 IN: help.markup
 
 PREDICATE: simple-element < array
@@ -276,7 +276,7 @@ M: f ($instance)
     $snippet ;
 
 : values-row ( seq -- seq )
-    unclip \ $snippet swap ?word-name 2array
+    unclip \ $snippet swap present 2array
     swap dup first word? [ \ $instance prefix ] when 2array ;
 
 : $values ( element -- )

basis/help/syntax/syntax.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel parser sequences words help
 help.topics namespaces vocabs definitions compiler.units
@@ -7,17 +7,13 @@ IN: help.syntax
 
 SYNTAX: HELP:
     scan-word bootstrap-word
-    dup set-word
+    [ >link save-location ] [ [ \ ; parse-until >array ] dip set-word-help ] bi ;
-    dup >link save-location
-    \ ; parse-until >array swap set-word-help ;
 
 SYNTAX: ARTICLE:
     location [
-        \ ; parse-until >array [ first2 ] keep 2 tail <article>
+        \ ; parse-until >array [ first2 ] [ 2 tail ] bi <article>
         over add-article >link
     ] dip remember-definition ;
 
 SYNTAX: ABOUT:
-    in get vocab
+    in get vocab scan-object >>help changed-definition ;
-    dup changed-definition
-    scan-object >>help drop ;

basis/help/tips/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/help/tips/tips-docs.factor

@@ -0,0 +1,27 @@
+IN: help.tips
+USING: help.markup help.syntax debugger ;
+
+TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ;
+
+TIP: "Learn to use " { $link "dataflow-combinators" } "." ;
+
+TIP: "Learn to use " { $link "editor" } " to be able to jump to the source code for word definitions from the listener." ;
+
+TIP: "Check out " { $url "http://concatenative.org/wiki/view/Factor/FAQ" } " to get answers to frequently-asked questions." ;
+
+TIP: "Drop by the " { $snippet "#concatenative" } " IRC channel on " { $snippet "irc.freenode.net" } " some time." ;
+
+TIP: "You can write documentation for your own code using the " { $link "help" } "." ;
+
+TIP: "You can write graphical applications using the " { $link "ui" } "." ;
+
+ARTICLE: "all-tips-of-the-day" "All tips of the day"
+{ $tips-of-the-day } ;
+
+ARTICLE: "tips-of-the-day" "Tips of the day"
+"The " { $vocab-link "help.tips" } " vocabulary provides a facility for displaying tips of the day in the " { $link "ui-listener" } ". Tips are defined with a parsing word:"
+{ $subsection POSTPONE: TIP: }
+"All tips defined so far:"
+{ $subsection "all-tips-of-the-day" } ;
+
+ABOUT: "tips-of-the-day"

basis/help/tips/tips.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser arrays namespaces sequences random help.markup kernel io
+io.styles colors.constants ;
+IN: help.tips
+
+SYMBOL: tips
+
+tips [ V{ } clone ] initialize
+
+SYNTAX: TIP: parse-definition >array tips get push ;
+
+: a-tip ( -- tip ) tips get random ;
+
+SYMBOL: tip-of-the-day-style
+
+H{
+    { page-color COLOR: lavender }
+    { border-width 5 }
+    { wrap-margin 500 }
+} tip-of-the-day-style set-global
+
+: $tip-of-the-day ( element -- )
+    drop
+    [
+        tip-of-the-day-style get
+        [
+            last-element off
+            "Tip of the day" $heading a-tip print-element nl
+            "— " print-element "all-tips-of-the-day" ($link)
+        ]
+        with-nesting
+    ] ($heading) ;
+
+: tip-of-the-day. ( -- ) { $tip-of-the-day } print-content nl ;
+
+: $tips-of-the-day ( element -- )
+    drop tips get [ nl nl ] [ print-element ] interleave ;

basis/help/tutorial/tutorial.factor

@@ -62,7 +62,9 @@ ARTICLE: "first-program-test" "Testing your first program"
     ""
     ": palindrome? ( str -- ? ) dup reverse = ;"
 }
-"We will now test our new word in the listener. First, push a string on the stack:"
+"We will now test our new word in the listener. First we have add the palindrome vocabulary to the listener's vocabulary search path:"
+{ $code "USE: palindrome"}
+"Next, push a string on the stack:"
 { $code "\"hello\"" }
 "Note that the stack display in the listener now shows this string. Having supplied the input, we call our word:"
 { $code "palindrome?" }
@@ -132,6 +134,8 @@ $nl
 $nl
 "We modify " { $snippet "palindrome?" } " to first apply " { $snippet "normalize" } " to its input:"
 { $code ": palindrome? ( str -- ? ) normalize dup reverse = ;" }
+"Factor compiles the file from the top down. So, be sure to place the definition for " { $snippet "normalize" } " above the definition for " { $snippet "palindrome?" } "."
+$nl
 "Now if you press " { $command tool "common" refresh-all } ", the source file should reload without any errors. You can run unit tests again, and this time, they will all pass:"
 { $code "\"palindrome\" test" } ;
 

basis/help/vocabs/vocabs-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io strings ;
-IN: tools.vocabs.browser
+IN: help.vocabs
 
 ARTICLE: "vocab-tags" "Vocabulary tags"
 { $all-tags } ;

basis/help/vocabs/vocabs-tests.factor

@@ -0,0 +1,5 @@
+IN: help.vocabs.tests
+USING: help.vocabs tools.test help.markup help vocabs ;
+
+[ ] [ { $vocab "scratchpad" } print-content ] unit-test
+[ ] [ "classes" vocab print-topic ] unit-test

basis/help/vocabs/vocabs.factor

@@ -6,17 +6,16 @@ classes.singleton classes.tuple classes.union combinators
 definitions effects fry generic help help.markup help.stylesheet
 help.topics io io.files io.pathnames io.styles kernel macros
 make namespaces prettyprint sequences sets sorting summary
-tools.vocabs vocabs vocabs.loader words words.symbol
+tools.vocabs vocabs vocabs.loader words words.symbol definitions.icons ;
-combinators.smart definitions.icons ;
+IN: help.vocabs
-IN: tools.vocabs.browser
+
+: $pretty-link ( element -- )
+    [ first definition-icon 1array $image " " print-element ]
+    [ $definition-link ]
+    bi ;
 
 : <$pretty-link> ( definition -- element )
-    [
+    1array \ $pretty-link prefix ;
-        [ definition-icon 1array \ $image prefix ]
-        [ drop " " ]
-        [ 1array \ $definition-link prefix ]
-        tri
-    ] output>array ;
 
 : vocab-row ( vocab -- row )
     [ <$pretty-link> ] [ vocab-summary ] bi 2array ;

basis/html/templates/chloe/chloe-tests.factor

@@ -5,7 +5,7 @@ splitting unicode.categories furnace accessors
 html.templates.chloe.compiler ;
 IN: html.templates.chloe.tests
 
-: run-template
+: run-template ( quot -- string )
     with-string-writer [ "\r\n\t" member? not ] filter
     "?>" split1 nip ; inline
 
@@ -37,7 +37,7 @@ IN: html.templates.chloe.tests
     ] run-template
 ] unit-test
 
-: test4-aux? t ;
+: test4-aux? ( -- ? ) t ;
 
 [ "True" ] [
     [
@@ -45,7 +45,7 @@ IN: html.templates.chloe.tests
     ] run-template
 ] unit-test
 
-: test5-aux? f ;
+: test5-aux? ( -- ? ) f ;
 
 [ "" ] [
     [

basis/http/http-tests.factor

@@ -13,7 +13,7 @@ IN: http.tests
 
 [ "application/octet-stream" binary ] [ "application/octet-stream" parse-content-type ] unit-test
 
-: lf>crlf "\n" split "\r\n" join ;
+: lf>crlf ( string -- string' ) "\n" split "\r\n" join ;
 
 STRING: read-request-test-1
 POST /bar HTTP/1.1
@@ -180,14 +180,14 @@ accessors namespaces threads
 http.server.responses http.server.redirection furnace.redirection
 http.server.dispatchers db.tuples ;
 
-: add-quit-action
+: add-quit-action ( responder -- responder )
     <action>
         [ stop-this-server "Goodbye" "text/html" <content> ] >>display
     "quit" add-responder ;
 
-: test-db-file "test.db" temp-file ;
+: test-db-file ( -- path ) "test.db" temp-file ;
 
-: test-db test-db-file <sqlite-db> ;
+: test-db ( -- db ) test-db-file <sqlite-db> ;
 
 [ test-db-file delete-file ] ignore-errors
 
@@ -268,7 +268,7 @@ test-db [
     test-httpd
 ] unit-test
 
-: 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ;
+: 404? ( response -- ? ) [ download-failed? ] [ response>> code>> 404 = ] bi and ;
 
 ! This should give a 404 not an infinite redirect loop
 [ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with

basis/io/backend/unix/unix-tests.factor

@@ -5,7 +5,7 @@ io.streams.duplex destructors make io.launcher ;
 IN: io.backend.unix.tests
 
 ! Unix domain stream sockets
-: socket-server "unix-domain-socket-test" temp-file ;
+: socket-server ( -- path ) "unix-domain-socket-test" temp-file ;
 
 [
     [ socket-server delete-file ] ignore-errors
@@ -33,8 +33,8 @@ yield
     ] { } make
 ] unit-test
 
-: datagram-server "unix-domain-datagram-test" temp-file ;
+: datagram-server ( -- path ) "unix-domain-datagram-test" temp-file ;
-: datagram-client "unix-domain-datagram-test-2" temp-file ;
+: datagram-client ( -- path ) "unix-domain-datagram-test-2" temp-file ;
 
 ! Unix domain datagram sockets
 [ datagram-server delete-file ] ignore-errors
@@ -104,7 +104,7 @@ datagram-client <local> <datagram>
 [ ] [ "d" get dispose ] unit-test
 
 ! Test error behavior
-: another-datagram "unix-domain-datagram-test-3" temp-file ;
+: another-datagram ( -- path ) "unix-domain-datagram-test-3" temp-file ;
 
 [ another-datagram delete-file ] ignore-errors
 

basis/io/encodings/strict/strict-docs.factor

@@ -3,6 +3,6 @@
 USING: help.syntax help.markup ;
 IN: io.encodings.strict
 
-HELP: strict ( encoding -- strict-encoding )
+HELP: strict ( code -- strict )
-{ $values { "encoding" "an encoding descriptor" } { "strict-encoding" "a strict encoding descriptor" } }
+{ $values { "code" "an encoding descriptor" } { "strict" "a strict encoding descriptor" } }
 { $description "Makes an encoding strict, that is, in the presence of a malformed code point, an error is thrown. Note that the existence of a replacement character in a file (U+FFFD) also throws an error." } ;

basis/io/encodings/utf16n/utf16n-tests.factor

@@ -2,7 +2,7 @@ USING: accessors alien.c-types kernel
 io.encodings.utf16 io.streams.byte-array tools.test ;
 IN: io.encodings.utf16n
 
-: correct-endian
+: correct-endian ( obj -- ? )
     code>> little-endian? [ utf16le = ] [ utf16be = ] if ;
 
 [ t ] [ B{ } utf16n <byte-reader> correct-endian ] unit-test

basis/io/files/unique/unique-docs.factor

@@ -23,7 +23,7 @@ HELP: unique-retries
 
 { unique-length unique-retries } related-words
 
-HELP: make-unique-file ( prefix suffix -- path )
+HELP: make-unique-file
 { $values { "prefix" "a string" } { "suffix" "a string" }
 { "path" "a pathname string" } }
 { $description "Creates a file that is guaranteed not to exist in the directory stored in " { $link current-temporary-directory } ". The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
@@ -31,18 +31,18 @@ HELP: make-unique-file ( prefix suffix -- path )
 
 { unique-file make-unique-file cleanup-unique-file } related-words
 
-HELP: cleanup-unique-file ( prefix suffix quot: ( path -- ) -- )
+HELP: cleanup-unique-file
 { $values { "prefix" "a string" } { "suffix" "a string" }
 { "quot" "a quotation" } }
 { $description "Creates a file with " { $link make-unique-file } " and calls the quotation with the path name on the stack." }
 { $notes "The unique file will be deleted after calling this word." } ;
 
-HELP: unique-directory ( -- path )
+HELP: unique-directory
 { $values { "path" "a pathname string" } }
 { $description "Creates a directory in the value in " { $link current-temporary-directory } " that is guaranteed not to exist in and returns the full pathname." }
 { $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ;
 
-HELP: cleanup-unique-directory ( quot -- )
+HELP: cleanup-unique-directory
 { $values { "quot" "a quotation" } }
 { $description "Creates a directory with " { $link unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-temporary-directory } " combinator. The quotation can access the " { $link current-temporary-directory } " symbol for the name of the temporary directory. Subsequent unique files will be created in this unique directory until the combinator returns." }
 { $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation. This combinator is like " { $link with-unique-directory } " but does not delete the directory." } ;

basis/io/streams/duplex/duplex-tests.factor

@@ -5,13 +5,13 @@ IN: io.streams.duplex.tests
 ! Test duplex stream close behavior
 TUPLE: closing-stream < disposable ;
 
-: <closing-stream> closing-stream new ;
+: <closing-stream> ( -- stream ) closing-stream new ;
 
 M: closing-stream dispose* drop ;
 
 TUPLE: unclosable-stream ;
 
-: <unclosable-stream> unclosable-stream new ;
+: <unclosable-stream> ( -- stream ) unclosable-stream new ;
 
 M: unclosable-stream dispose
     "Can't close me!" throw ;

basis/listener/listener-tests.factor

@@ -50,7 +50,7 @@ SYNTAX: hello "Hi" print ;
 
 [
     [ ] [
-        "IN: listener.tests : hello\n\"world\" ;" parse-interactive
+        "IN: listener.tests : hello ( -- )\n\"world\" ;" parse-interactive
         drop
     ] unit-test
 ] with-file-vocabs

basis/lists/lazy/lazy-docs.factor

@@ -108,7 +108,7 @@ HELP: lappend
 { $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-append> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } ;
 
 HELP: lfrom-by
-{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "list" "a lazy list of integers" } }
+{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "lazy-from-by" "a lazy list of integers" } }
 { $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } ;
 
 HELP: lfrom

basis/lists/lazy/lazy.factor

@@ -203,7 +203,7 @@ M: lazy-append nil? ( lazy-append -- bool )
 
 TUPLE: lazy-from-by n quot ;
 
-C: lfrom-by lazy-from-by ( n quot -- list )
+C: lfrom-by lazy-from-by
 
 : lfrom ( n -- list )
     [ 1+ ] lfrom-by ;

basis/lists/lists-docs.factor

@@ -83,10 +83,6 @@ HELP: nil?
 
 { nil nil? } related-words
 
-HELP: list? ( object -- ? )
-{ $values { "object" "an object" } { "?" "a boolean" } }
-{ $description "Returns true if the object conforms to the list protocol." } ;
-
 { 1list 2list 3list } related-words
 
 HELP: 1list

basis/locals/locals-tests.factor

@@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
 namespaces arrays strings prettyprint io.streams.string parser
 accessors generic eval combinators combinators.short-circuit
 combinators.short-circuit.smart math.order math.functions
-definitions compiler.units fry lexer words.symbol see ;
+definitions compiler.units fry lexer words.symbol see multiline ;
 IN: locals.tests
 
 :: foo ( a b -- a a ) a a ;
@@ -192,14 +192,14 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
 DEFER: xyzzy
 
 [ ] [
-    "IN: locals.tests USE: math GENERIC: xyzzy M: integer xyzzy ;"
+    "IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) M: integer xyzzy ;"
     <string-reader> "lambda-generic-test" parse-stream drop
 ] unit-test
 
 [ 10 ] [ 10 xyzzy ] unit-test
 
 [ ] [
-    "IN: locals.tests USE: math USE: locals GENERIC: xyzzy M:: integer xyzzy ( n -- ) 5 ;"
+    "IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) M:: integer xyzzy ( n -- x ) 5 ;"
     <string-reader> "lambda-generic-test" parse-stream drop
 ] unit-test
 
@@ -245,7 +245,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
 
 [ 5 ] [ 1 next-method-test ] unit-test
 
-: no-with-locals-test { 1 2 3 } [| x | x 3 + ] map ;
+: no-with-locals-test ( -- seq ) { 1 2 3 } [| x | x 3 + ] map ;
 
 [ { 4 5 6 } ] [ no-with-locals-test ] unit-test
 
@@ -259,7 +259,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
 
 :: a-word-with-locals ( a b -- ) ;
 
-: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" ;
+CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n"
 
 [ ] [ new-definition eval ] unit-test
 
@@ -268,7 +268,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
     new-definition =
 ] unit-test
 
-: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" ;
+CONSTANT: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n"
 
 GENERIC: method-with-locals ( x -- y )
 
@@ -392,6 +392,65 @@ ERROR: punned-class x ;
 
 [ 9 ] [ 3 big-case-test ] unit-test
 
+! Dan found this problem
+: littledan-case-problem-1 ( a -- b )
+    {
+        { t [ 3 ] }
+        { f [ 4 ] }
+        [| x | x 12 + { "howdy" } nth ]
+    } case ;
+
+\ littledan-case-problem-1 must-infer
+
+[ "howdy" ] [ -12 \ littledan-case-problem-1 def>> call ] unit-test
+[ "howdy" ] [ -12 littledan-case-problem-1 ] unit-test
+
+:: littledan-case-problem-2 ( a -- b )
+    a {
+        { t [ a not ] }
+        { f [ 4 ] }
+        [| x | x a - { "howdy" } nth ]
+    } case ;
+
+\ littledan-case-problem-2 must-infer
+
+[ "howdy" ] [ -12 \ littledan-case-problem-2 def>> call ] unit-test
+[ "howdy" ] [ -12 littledan-case-problem-2 ] unit-test
+
+:: littledan-cond-problem-1 ( a -- b )
+    a {
+        { [ dup 0 < ] [ drop a not ] }
+        { [| y | y y 0 > ] [ drop 4 ] }
+        [| x | x a - { "howdy" } nth ]
+    } cond ;
+
+\ littledan-cond-problem-1 must-infer
+
+[ f ] [ -12 \ littledan-cond-problem-1 def>> call ] unit-test
+[ 4 ] [ 12 \ littledan-cond-problem-1 def>> call ] unit-test
+[ "howdy" ] [ 0 \ littledan-cond-problem-1 def>> call ] unit-test
+[ f ] [ -12 littledan-cond-problem-1 ] unit-test
+[ 4 ] [ 12 littledan-cond-problem-1 ] unit-test
+[ "howdy" ] [ 0 littledan-cond-problem-1 ] unit-test
+
+/*
+:: littledan-case-problem-3 ( a quot -- b )
+    a {
+        { t [ a not ] }
+        { f [ 4 ] }
+        quot
+    } case ; inline
+
+[ f ] [ t [ ] littledan-case-problem-3 ] unit-test
+[ 144 ] [ 12 [ sq ] littledan-case-problem-3 ] unit-test
+[| | [| a | a ] littledan-case-problem-3 ] must-infer
+
+: littledan-case-problem-4 ( a -- b )
+    [ 1 + ] littledan-case-problem-3 ;
+
+\ littledan-case-problem-4 must-infer
+*/
+
 GENERIC: lambda-method-forget-test ( a -- b )
 
 M:: integer lambda-method-forget-test ( a -- b ) ;

basis/locals/locals.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lexer macros memoize parser sequences vocabs
 vocabs.loader words kernel namespaces locals.parser locals.types
@@ -17,7 +17,7 @@ SYNTAX: [let* parse-let* over push-all ;
 
 SYNTAX: [wlet parse-wlet over push-all ;
 
-SYNTAX: :: (::) define ;
+SYNTAX: :: (::) define-declared ;
 
 SYNTAX: M:: (M::) define ;
 

basis/locals/macros/macros.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel locals.types macros.expander ;
+USING: accessors assocs kernel locals.types macros.expander fry ;
 IN: locals.macros
 
 M: lambda expand-macros clone [ expand-macros ] change-body ;
@@ -14,3 +14,6 @@ M: binding-form expand-macros
 
 M: binding-form expand-macros* expand-macros literal ;
 
+M: lambda condomize? drop t ;
+
+M: lambda condomize '[ @ ] ;

basis/locals/parser/parser.factor

@@ -103,18 +103,19 @@ M: lambda-parser parse-quotation ( -- quotation )
     "|" expect "|" parse-wbindings
     (parse-lambda) <wlet> ?rewrite-closures ;
 
-: parse-locals ( -- vars assoc )
+: parse-locals ( -- effect vars assoc )
-    "(" expect ")" parse-effect
+    complete-effect
-    word [ over "declared-effect" set-word-prop ] when*
+    dup
     in>> [ dup pair? [ first ] when ] map make-locals ;
 
-: parse-locals-definition ( word reader -- word quot )
+: parse-locals-definition ( word reader -- word quot effect )
     [ parse-locals ] dip
     ((parse-lambda)) <lambda>
-    [ "lambda" set-word-prop ]
+    [ nip "lambda" set-word-prop ]
-    [ rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ] 2bi ; inline
+    [ nip rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ]
+    [ drop nip ] 3tri ; inline
 
-: (::) ( -- word def )
+: (::) ( -- word def effect )
     CREATE-WORD
     [ parse-definition ]
     parse-locals-definition ;
@@ -123,5 +124,5 @@ M: lambda-parser parse-quotation ( -- quotation )
     CREATE-METHOD
     [
         [ parse-definition ] 
-        parse-locals-definition
+        parse-locals-definition drop
     ] with-method-definition ;

basis/macros/expander/expander.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private namespaces make
 quotations accessors words continuations vectors effects math
-generalizations fry ;
+generalizations fry arrays ;
 IN: macros.expander
 
 GENERIC: expand-macros ( quot -- quot' )
@@ -17,7 +17,23 @@ SYMBOL: stack
     [ delete-all ]
     bi ;
 
-: literal ( obj -- ) stack get push ;
+GENERIC: condomize? ( obj -- ? )
+
+M: array condomize? [ condomize? ] any? ;
+
+M: callable condomize? [ condomize? ] any? ;
+
+M: object condomize? drop f ;
+
+GENERIC: condomize ( obj -- obj' )
+
+M: array condomize [ condomize ] map ;
+
+M: callable condomize [ condomize ] map ;
+
+M: object condomize ;
+
+: literal ( obj -- ) dup condomize? [ condomize ] when stack get push ;
 
 GENERIC: expand-macros* ( obj -- )
 

basis/macros/macros-tests.factor

@@ -2,16 +2,22 @@ IN: macros.tests
 USING: tools.test macros math kernel arrays
 vectors io.streams.string prettyprint parser eval see ;
 
-MACRO: see-test ( a b -- c ) + ;
+MACRO: see-test ( a b -- quot ) + ;
 
-[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- c ) + ;\n" ]
+[ t ] [ \ see-test macro? ] unit-test
+
+[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" ]
 [ [ \ see-test see ] with-string-writer ]
 unit-test
 
+[ t ] [ \ see-test macro? ] unit-test
+
 [ t ] [
     "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval
     [ \ see-test see ] with-string-writer =
 ] unit-test
 
+[ f ] [ \ see-test macro? ] unit-test
+
 [ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval ] unit-test
 

basis/macros/macros.factor

@@ -6,15 +6,16 @@ IN: macros
 
 <PRIVATE
 
-: real-macro-effect ( word -- effect' )
+: real-macro-effect ( effect -- effect' )
-    stack-effect in>> 1 <effect> ;
+    in>> { "quot" } <effect> ;
 
 PRIVATE>
 
-: define-macro ( word definition -- )
+: define-macro ( word definition effect -- )
-    [ "macro" set-word-prop ]
+    real-macro-effect
-    [ over real-macro-effect memoize-quot [ call ] append define ]
+    [ [ memoize-quot [ call ] append ] keep define-declared ]
-    2bi ;
+    [ drop "macro" set-word-prop ]
+    3bi ;
 
 SYNTAX: MACRO: (:) define-macro ;
 

basis/math/bitwise/bitwise-docs.factor

@@ -139,8 +139,8 @@ HELP: flags
 { $examples
     { $example "USING: math.bitwise kernel prettyprint ;"
         "IN: scratchpad"
-        ": MY-CONSTANT HEX: 1 ; inline"
+        "CONSTANT: x HEX: 1"
-        "{ HEX: 20 MY-CONSTANT BIN: 100 } flags .h"
+        "{ HEX: 20 x BIN: 100 } flags .h"
         "25"
     }
 } ;

basis/memoize/memoize-docs.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup ;
+USING: help.syntax help.markup words quotations effects ;
 IN: memoize
 
 HELP: define-memoized
-{ $values { "word" "the word to be defined" } { "quot" "a quotation" } }
+{ $values { "word" word } { "quot" quotation } { "effect" effect } }
 { $description "defines the given word at runtime as one which memoizes its output given a particular input" }
 { $notes "A maximum of four input and four output arguments can be used" }
 { $see-also POSTPONE: MEMO: } ;

basis/memoize/memoize.factor

@@ -34,11 +34,10 @@ M: too-many-arguments summary
 
 PRIVATE>
 
-: define-memoized ( word quot -- )
+: define-memoized ( word quot effect -- )
-    [ H{ } clone ] dip
+    [ drop "memo-quot" set-word-prop ]
-    [ pick stack-effect make-memoizer define ]
+    [ 2drop H{ } clone "memoize" set-word-prop ]
-    [ nip "memo-quot" set-word-prop ]
+    [ [ [ dup "memoize" word-prop ] 2dip make-memoizer ] keep define-declared ]
-    [ drop "memoize" set-word-prop ]
     3tri ;
 
 SYNTAX: MEMO: (:) define-memoized ;

basis/models/models-tests.factor

@@ -4,7 +4,7 @@ IN: models.tests
 
 TUPLE: model-tester hit? ;
 
-: <model-tester> model-tester new ;
+: <model-tester> ( -- model-tester ) model-tester new ;
 
 M: model-tester model-changed nip t >>hit? drop ;
 

basis/models/range/range-tests.factor

@@ -3,7 +3,7 @@ USING: arrays generic kernel math models namespaces sequences assocs
 tools.test models.range ;
 
 ! Test <range> 
-: setup-range 0 0 0 255 <range> ;
+: setup-range ( -- range ) 0 0 0 255 <range> ;
 
 ! clamp-value should not go past range ends
 [ 0   ] [ -10 setup-range clamp-value ] unit-test

basis/peg/parsers/parsers.factor

@@ -9,14 +9,14 @@ TUPLE: just-parser p1 ;
 
 CONSTANT: just-pattern
   [
-    execute dup [
+    dup [
       dup remaining>> empty? [ drop f ] unless
     ] when
   ]
 
 
 M: just-parser (compile) ( parser -- quot )
-  p1>> compile-parser just-pattern curry ;
+  p1>> compile-parser-quot just-pattern compose ;
 
 : just ( parser -- parser )
   just-parser boa wrap-peg ;

basis/peg/peg.factor

@@ -116,7 +116,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
   #! Evaluate a rule, return an ast resulting from it.
   #! Return fail if the rule failed. The rule has
   #! stack effect ( -- parse-result )
-  pos get swap execute process-rule-result ; inline
+  pos get swap execute( -- parse-result ) process-rule-result ; inline
 
 : memo ( pos id -- memo-entry )
   #! Return the result from the memo cache. 
@@ -244,14 +244,15 @@ TUPLE: peg-head rule-id involved-set eval-set ;
 
 : with-packrat ( input quot -- result )
   #! Run the quotation with a packrat cache active.
-  swap [ 
+  [ 
-    input set
+    swap input set
     0 pos set
     f lrstack set
     V{ } clone error-stack set
     H{ } clone \ heads set
     H{ } clone \ packrat set
-  ] H{ } make-assoc swap bind ; inline
+    call
+  ] with-scope ; inline
 
 
 GENERIC: (compile) ( peg -- quot )
@@ -264,20 +265,16 @@ GENERIC: (compile) ( peg -- quot )
   ] if ;
     
 : execute-parser ( word -- result )
-  pos get apply-rule process-parser-result ; inline
+  pos get apply-rule process-parser-result ;
-
-: parser-body ( parser -- quot )
-  #! Return the body of the word that is the compiled version
-  #! of the parser.
-  gensym 2dup swap peg>> (compile) (( -- result )) define-declared
-  swap dupd id>> "peg-id" set-word-prop
-  [ execute-parser ] curry ;
 
 : preset-parser-word ( parser -- parser word )
   gensym [ >>compiled ] keep ;
 
 : define-parser-word ( parser word -- )
-  swap parser-body (( -- result )) define-declared ;
+  #! Return the body of the word that is the compiled version
+  #! of the parser.
+  2dup swap peg>> (compile) (( -- result )) define-declared
+  swap id>> "peg-id" set-word-prop ;
 
 : compile-parser ( parser -- word )
   #! Look to see if the given parser has been compiled.
@@ -292,19 +289,22 @@ GENERIC: (compile) ( peg -- quot )
     preset-parser-word [ define-parser-word ] keep
   ] if* ;
 
+: compile-parser-quot ( parser -- quot )
+  compile-parser [ execute-parser ] curry ;
+
 SYMBOL: delayed
 
 : fixup-delayed ( -- )
   #! Work through all delayed parsers and recompile their
   #! words to have the correct bodies.
   delayed get [
-    call( -- parser ) compile-parser 1quotation (( -- result )) define-declared
+    call( -- parser ) compile-parser-quot (( -- result )) define-declared
   ] assoc-each ;
 
 : compile ( parser -- word )
   [
     H{ } clone delayed [ 
-      compile-parser fixup-delayed 
+      compile-parser-quot (( -- result )) define-temp fixup-delayed 
     ] with-variable
   ] with-compilation-unit ;
 
@@ -411,8 +411,8 @@ M: seq-parser (compile) ( peg -- quot )
   [
     [ input-slice V{ } clone <parse-result> ] %
     [
-      parsers>> unclip compile-parser 1quotation [ parse-seq-element ] curry ,
+      parsers>> unclip compile-parser-quot [ parse-seq-element ] curry ,
-      [ compile-parser 1quotation [ merge-errors ] compose [ parse-seq-element ] curry , ] each 
+      [ compile-parser-quot [ merge-errors ] compose [ parse-seq-element ] curry , ] each 
     ] { } make , \ 1&& , 
   ] [ ] make ;
 
@@ -421,8 +421,8 @@ TUPLE: choice-parser parsers ;
 M: choice-parser (compile) ( peg -- quot )
   [ 
     [
-      parsers>> [ compile-parser ] map 
+      parsers>> [ compile-parser-quot ] map 
-      unclip 1quotation , [ 1quotation [ merge-errors ] compose , ] each
+      unclip , [ [ merge-errors ] compose , ] each
     ] { } make , \ 0|| ,
   ] [ ] make ;
 
@@ -438,7 +438,7 @@ TUPLE: repeat0-parser p1 ;
   ] if* ; inline recursive
 
 M: repeat0-parser (compile) ( peg -- quot )
-  p1>> compile-parser 1quotation '[ 
+  p1>> compile-parser-quot '[ 
     input-slice V{ } clone <parse-result> _ swap (repeat) 
   ] ; 
 
@@ -452,7 +452,7 @@ TUPLE: repeat1-parser p1 ;
   ] if* ;
 
 M: repeat1-parser (compile) ( peg -- quot )
-  p1>> compile-parser 1quotation '[ 
+  p1>> compile-parser-quot '[ 
     input-slice V{ } clone <parse-result> _ swap (repeat) repeat1-empty-check  
   ] ; 
 
@@ -462,7 +462,7 @@ TUPLE: optional-parser p1 ;
   [ input-slice f <parse-result> ] unless* ;
 
 M: optional-parser (compile) ( peg -- quot )
-  p1>> compile-parser 1quotation '[ @ check-optional ] ;
+  p1>> compile-parser-quot '[ @ check-optional ] ;
 
 TUPLE: semantic-parser p1 quot ;
 
@@ -474,7 +474,7 @@ TUPLE: semantic-parser p1 quot ;
   ] if ; inline
 
 M: semantic-parser (compile) ( peg -- quot )
-  [ p1>> compile-parser 1quotation ] [ quot>> ] bi  
+  [ p1>> compile-parser-quot ] [ quot>> ] bi  
   '[ @ _ check-semantic ] ;
 
 TUPLE: ensure-parser p1 ;
@@ -483,7 +483,7 @@ TUPLE: ensure-parser p1 ;
   [ ignore <parse-result> ] [ drop f ] if ;
 
 M: ensure-parser (compile) ( peg -- quot )
-  p1>> compile-parser 1quotation '[ input-slice @ check-ensure ] ;
+  p1>> compile-parser-quot '[ input-slice @ check-ensure ] ;
 
 TUPLE: ensure-not-parser p1 ;
 
@@ -491,7 +491,7 @@ TUPLE: ensure-not-parser p1 ;
   [ drop f ] [ ignore <parse-result> ] if ;
 
 M: ensure-not-parser (compile) ( peg -- quot )
-  p1>> compile-parser 1quotation '[ input-slice @ check-ensure-not ] ;
+  p1>> compile-parser-quot '[ input-slice @ check-ensure-not ] ;
 
 TUPLE: action-parser p1 quot ;
 
@@ -503,12 +503,12 @@ TUPLE: action-parser p1 quot ;
   ] if ; inline
 
 M: action-parser (compile) ( peg -- quot )
-  [ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ _ check-action ] ;
+  [ p1>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ;
 
 TUPLE: sp-parser p1 ;
 
 M: sp-parser (compile) ( peg -- quot )
-  p1>> compile-parser 1quotation '[ 
+  p1>> compile-parser-quot '[ 
     input-slice [ blank? ] trim-head-slice input-from pos set @ 
   ] ;
 
@@ -527,7 +527,7 @@ M: box-parser (compile) ( peg -- quot )
   #! to produce the parser to be compiled.
   #! This differs from 'delay' which calls
   #! it at run time.
-  quot>> call( -- parser ) compile-parser 1quotation ;
+  quot>> call( -- parser ) compile-parser-quot ;
 
 PRIVATE>
 
@@ -618,7 +618,7 @@ ERROR: parse-failed input word ;
 
 SYNTAX: PEG:
   (:)
-  [let | def [ ] word [ ] |
+  [let | effect [ ] def [ ] word [ ] |
     [
       [
         [let | compiled-def [ def call compile ] |
@@ -626,7 +626,7 @@ SYNTAX: PEG:
             dup compiled-def compiled-parse
             [ ast>> ] [ word parse-failed ] ?if
           ]
-          word swap define
+          word swap effect define-declared
         ]
       ] with-compilation-unit
     ] over push-all

basis/persistent/heaps/heaps-tests.factor

@@ -1,9 +1,9 @@
 USING: persistent.heaps tools.test ;
 IN: persistent.heaps.tests
 
-: test-input
+CONSTANT: test-input
     { { "hello" 3 } { "goodbye" 2 } { "whatever" 5 }
-      { "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } } ;
+      { "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } }
 
 [
     { { "baz" -7 } { "bar" -1 } { "bing" 0 } { "foo" 1 }

basis/prettyprint/prettyprint-tests.factor

@@ -63,7 +63,7 @@ unit-test
 [ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ]
 [ [ \ bar see ] with-string-writer ] unit-test
 
-: blah 
+: blah ( a a a a a a a a a a a a a a a a a a a a -- )
     drop
     drop
     drop
@@ -102,7 +102,7 @@ unit-test
         ] keep =
     ] with-scope ;
 
-GENERIC: method-layout
+GENERIC: method-layout ( a -- b )
 
 M: complex method-layout
     "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
@@ -135,7 +135,7 @@ M: object method-layout ;
     [ \ method-layout see-methods ] with-string-writer "\n" split
 ] unit-test
 
-: soft-break-test
+: soft-break-test ( -- str )
     {
         "USING: kernel math sequences strings ;"
         "IN: prettyprint.tests"
@@ -152,7 +152,7 @@ M: object method-layout ;
 
 DEFER: parse-error-file
 
-: another-soft-break-test
+: another-soft-break-test ( -- str )
     {
         "USING: make sequences ;"
         "IN: prettyprint.tests"
@@ -166,7 +166,7 @@ DEFER: parse-error-file
     check-see
 ] unit-test
 
-: string-layout
+: string-layout ( -- str )
     {
         "USING: accessors debugger io kernel ;"
         "IN: prettyprint.tests"
@@ -187,7 +187,7 @@ DEFER: parse-error-file
 
 \ send soft "break-after" set-word-prop
 
-: final-soft-break-test
+: final-soft-break-test ( -- str )
     {
         "USING: kernel sequences ;"
         "IN: prettyprint.tests"
@@ -202,7 +202,7 @@ DEFER: parse-error-file
     "final-soft-break-layout" final-soft-break-test check-see
 ] unit-test
 
-: narrow-test
+: narrow-test ( -- str )
     {
         "USING: arrays combinators continuations kernel sequences ;"
         "IN: prettyprint.tests"
@@ -218,7 +218,7 @@ DEFER: parse-error-file
     "narrow-layout" narrow-test check-see
 ] unit-test
 
-: another-narrow-test
+: another-narrow-test ( -- str )
     {
         "IN: prettyprint.tests"
         ": another-narrow-layout ( -- obj )"
@@ -326,7 +326,7 @@ INTERSECTION: intersection-see-test sequence number ;
     
 TUPLE: started-out-hustlin' ;
 
-GENERIC: ended-up-ballin'
+GENERIC: ended-up-ballin' ( a -- b )
 
 M: started-out-hustlin' ended-up-ballin' ; inline
 

basis/promises/promises-docs.factor

@@ -1,34 +1,20 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-
 USING: help.markup help.syntax ;
 IN: promises
 
 HELP: promise 
 { $values { "quot" { $quotation "( -- X )" } } { "promise" "a promise object" } }
-{ $description "Creates a promise to return a value. When forced this quotation is called and the value returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } 
+{ $description "Creates a promise to return a value. When forced this quotation is called and the value returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } ;
-{ $see-also force promise-with promise-with2 } ;
-
-HELP: promise-with
-{ $values { "value" "an object" } { "quot" { $quotation "( value -- X )" } } { "promise" "a promise object" } }
-{ $description "Creates a promise to return a value. When forced this quotation is called with the given value on the stack and the result returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } 
-{ $see-also force promise promise-with2 } ;
-
-HELP: promise-with2
-{ $values { "value1" "an object" } { "value2" "an object" } { "quot" { $quotation "( value1 value2 -- X )" } } { "promise" "a promise object" } }
-{ $description "Creates a promise to return a value. When forced this quotation is called with the given values on the stack and the result returned. The value is memorised so that calling " { $link force } " again does not call the quotation again, instead the previous value is returned directly." } 
-{ $see-also force promise promise-with2 } ;
 
 HELP: force
 { $values { "promise" "a promise object" } { "value" "a factor object" } }
-{ $description "Calls the quotation associated with the promise if it has not been called before, and returns the value. If the promise has been forced previously, returns the value from the previous call." } 
+{ $description "Calls the quotation associated with the promise if it has not been called before, and returns the value. If the promise has been forced previously, returns the value from the previous call." } ;
-{ $see-also promise promise-with promise-with2 } ;
 
 HELP: LAZY:
-{ $syntax "LAZY: word definition... ;" } 
+{ $syntax "LAZY: word ( stack -- effect ) definition... ;" } 
 { $values { "word" "a new word to define" } { "definition" "a word definition" } }
 { $description "Creates a lazy word in the current vocabulary. When executed the word will return a " { $link promise } " that when forced, executes the word definition. Any values on the stack that are required by the word definition are captured along with the promise." } 
 { $examples
   { $example "USING: arrays sequences prettyprint promises ;" "IN: scratchpad" "LAZY: zeroes ( -- pair ) 0 zeroes 2array ;" "zeroes force second force first ." "0" }
-}
+} ;
-{ $see-also force promise-with promise-with2 } ;

basis/promises/promises-tests.factor

@@ -0,0 +1,7 @@
+IN: promises.tests
+USING: promises math tools.test ;
+
+LAZY: lazy-test ( a -- b ) 1 + ;
+
+{ 1 1 } [ lazy-test ] must-infer-as
+[ 3 ] [ 2 lazy-test force ] unit-test

basis/promises/promises.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel sequences math arrays namespaces
+parser effects generalizations fry words accessors ;
+IN: promises
+
+TUPLE: promise quot forced? value ;
+
+: promise ( quot -- promise ) f f \ promise boa ;
+
+: force ( promise -- value )
+    dup forced?>> [
+        dup quot>> call( -- value ) >>value
+        t >>forced?
+    ] unless
+    value>> ;
+
+: make-lazy-quot ( quot effect -- quot )
+    in>> length '[ _ _ ncurry promise ] ;
+
+SYNTAX: LAZY:
+    (:) [ make-lazy-quot ] [ 2nip ] 3bi define-declared ;

basis/refs/refs-docs.factor

@@ -37,14 +37,14 @@ HELP: key-ref
 { $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link <key-ref> } "." } ;
 
 HELP: <key-ref>
-{ $values { "key" object } { "assoc" "an assoc" } { "ref" key-ref } }
+{ $values { "assoc" "an assoc" } { "key" object } { "key-ref" key-ref } }
 { $description "Creates a reference to a key stored in an assoc." } ;
 
 HELP: value-ref
 { $class-description "Instances of this class identify a value associated to a key in an associative structure. New value references are created by calling " { $link <value-ref> } "." } ;
 
 HELP: <value-ref>
-{ $values { "key" object } { "assoc" "an assoc" } { "ref" value-ref } }
+{ $values { "assoc" "an assoc" } { "key" object } { "value-ref" value-ref } }
 { $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ;
 
 { get-ref set-ref delete-ref } related-words

basis/refs/refs.factor

@@ -12,11 +12,11 @@ GENERIC: get-ref ( ref -- obj )
 GENERIC: set-ref ( obj ref -- )
 
 TUPLE: key-ref < ref ;
-C: <key-ref> key-ref ( assoc key -- ref )
+C: <key-ref> key-ref
 M: key-ref get-ref key>> ;
 M: key-ref set-ref >ref< rename-at ;
 
 TUPLE: value-ref < ref ;
-C: <value-ref> value-ref ( assoc key -- ref )
+C: <value-ref> value-ref
 M: value-ref get-ref >ref< at ;
 M: value-ref set-ref >ref< set-at ;

basis/see/see-docs.factor

@@ -25,7 +25,7 @@ HELP: definer
 { $examples
     { $example "USING: definitions prettyprint ;"
                "IN: scratchpad"
-               ": foo ; \\ foo definer . ."
+               ": foo ( -- ) ; \\ foo definer . ."
                ";\nPOSTPONE: :"
     }
     { $example "USING: definitions prettyprint ;"
@@ -50,6 +50,9 @@ $nl
 "Printing a definition:"
 { $subsection see }
 "Printing the methods defined on a generic word or class (see " { $link "objects" } "):"
-{ $subsection see-methods } ;
+{ $subsection see-methods }
+"Definition specifiers implementing the " { $link "definition-protocol" } " should also implement the " { $emphasis "see protocol" } ":"
+{ $subsection see* }
+{ $subsection synopsis* } ;
 
 ABOUT: "see"

basis/see/see.factor

@@ -10,6 +10,8 @@ prettyprint.sections sequences sets sorting strings summary
 words words.symbol ;
 IN: see
 
+GENERIC: synopsis* ( defspec -- )
+
 GENERIC: see* ( defspec -- )
 
 : see ( defspec -- ) see* nl ;

basis/serialize/serialize-tests.factor

@@ -7,7 +7,7 @@ sequences math prettyprint parser classes math.constants
 io.encodings.binary random assocs serialize.private ;
 IN: serialize.tests
 
-: test-serialize-cell
+: test-serialize-cell ( a -- ? )
     2^ random dup
     binary [ serialize-cell ] with-byte-writer
     binary [ deserialize-cell ] with-byte-reader = ;
@@ -27,7 +27,7 @@ TUPLE: serialize-test a b ;
 
 C: <serialize-test> serialize-test
 
-: objects
+CONSTANT: objects
     {
         f
         t
@@ -52,7 +52,7 @@ C: <serialize-test> serialize-test
         << 1 [ 2 ] curry parsed >>
         { { "a" "bc" } { "de" "fg" } }
         H{ { "a" "bc" } { "de" "fg" } }
-    } ;
+    }
 
 : check-serialize-1 ( obj -- ? )
     "=====" print

basis/stack-checker/stack-checker-docs.factor

@@ -33,9 +33,9 @@ $nl
 "A general rule of thumb is that any word which applies " { $link call } " or " { $link curry } " to one of its inputs must be declared " { $link POSTPONE: inline } "."
 $nl
 "Here is an example where the stack effect cannot be inferred:"
-{ $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." }
+{ $code ": foo ( -- n quot ) 0 [ + ] ;" "[ foo reduce ] infer." }
 "However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":"
-{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
+{ $example ": foo ( -- n quot ) 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
 "Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:"
 { $example
   "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help."

basis/stack-checker/stack-checker-tests.factor

@@ -292,7 +292,7 @@ DEFER: bar
 
 [ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
 
-: m' dup curry call ; inline
+: m' ( quot -- ) dup curry call ; inline
 
 [ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
 

basis/tools/annotations/annotations-tests.factor

@@ -2,7 +2,7 @@ USING: tools.test tools.annotations tools.time math parser eval
 io.streams.string kernel strings ;
 IN: tools.annotations.tests
 
-: foo ;
+: foo ( -- ) ;
 \ foo watch
 
 [ ] [ foo ] unit-test