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

Conflicts:

	basis/cocoa/types/types.factor

basis/alien/arrays/arrays.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays alien.c-types alien.structs
-sequences math kernel namespaces libc cpu.architecture ;
+sequences math kernel namespaces make libc cpu.architecture ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;

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

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: byte-arrays arrays assocs kernel kernel.private libc math
-namespaces parser sequences strings words assocs splitting
+namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
 accessors combinators effects continuations ;

basis/alien/structs/fields/fields.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel kernel.private math namespaces
-sequences strings words effects combinators alien.c-types ;
+make sequences strings words effects combinators alien.c-types ;
 IN: alien.structs.fields
 
 TUPLE: field-spec name offset type reader writer ;

basis/base64/base64.factor

@@ -1,12 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences io.binary splitting grouping ;
+USING: kernel math sequences io.binary splitting grouping
+accessors ;
 IN: base64
 
 <PRIVATE
 
-: count-end ( seq quot -- count )
+: count-end ( seq quot -- n )
-    >r [ length ] keep r> find-last drop dup [ - 1- ] [ 2drop 0 ] if ; inline
+    trim-right-slice [ seq>> length ] [ to>> ] bi - ; inline
 
 : ch>base64 ( ch -- ch )
     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" nth ;
@@ -21,13 +22,16 @@ IN: base64
     } nth ;
 
 : encode3 ( seq -- seq )
-    be> 4 <reversed> [ -6 * shift HEX: 3f bitand ch>base64 ] with B{ } map-as ;
+    be> 4 <reversed> [
+        -6 * shift HEX: 3f bitand ch>base64
+    ] with B{ } map-as ;
 
 : decode4 ( str -- str )
     0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ;
 
 : >base64-rem ( str -- str )
-    [ 3 0 pad-right encode3 ] [ length 1+ ] bi head 4 CHAR: = pad-right ;
+    [ 3 0 pad-right encode3 ] [ length 1+ ] bi
+    head-slice 4 CHAR: = pad-right ;
 
 PRIVATE>
 
@@ -42,5 +46,5 @@ PRIVATE>
 : base64> ( base64 -- str )
     #! input length must be a multiple of 4
     [ 4 <groups> [ decode4 ] map concat ]
-    [ [ CHAR: = = not ] count-end ]
+    [ [ CHAR: = = ] count-end ]
     bi head* ;

basis/bootstrap/image/image.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays byte-arrays generic assocs hashtables assocs
-hashtables.private io kernel kernel.private math namespaces
+hashtables.private io kernel kernel.private math namespaces make
 parser prettyprint sequences sequences.private strings sbufs
 vectors words quotations assocs system layouts splitting
 grouping growable classes classes.builtin classes.tuple
@@ -280,7 +280,7 @@ M: f '
         [
             [
                 {
-                    [ hashcode , ]
+                    [ hashcode <fake-bignum> , ]
                     [ name>> , ]
                     [ vocabulary>> , ]
                     [ def>> , ]

basis/bootstrap/image/upload/upload.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: checksums checksums.openssl splitting assocs
-kernel io.files bootstrap.image sequences io namespaces
+kernel io.files bootstrap.image sequences io namespaces make
 io.launcher math io.encodings.ascii ;
 IN: bootstrap.image.upload
 

basis/channels/remote/remote.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 ! Remote Channels
-USING: kernel init namespaces assocs arrays random
+USING: kernel init namespaces make assocs arrays random
 sequences channels match concurrency.messaging
 concurrency.distributed threads accessors ;
 IN: channels.remote

basis/checksums/common/common.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.bitwise strings io.binary namespaces
-grouping ;
+make grouping ;
 IN: checksums.common
 
 SYMBOL: bytes-read

basis/checksums/sha1/sha1.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays combinators kernel io io.encodings.binary io.files
 io.streams.byte-array math.vectors strings sequences namespaces
-math parser sequences assocs grouping vectors io.binary hashtables
+make math parser sequences assocs grouping vectors io.binary
-symbols math.bitwise checksums checksums.common ;
+hashtables symbols math.bitwise checksums checksums.common ;
 IN: checksums.sha1
 
 ! Implemented according to RFC 3174.

basis/checksums/sha2/sha2.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel splitting grouping math sequences namespaces
+USING: kernel splitting grouping math sequences namespaces make
 io.binary symbols math.bitwise checksums checksums.common
 sbufs strings ;
 IN: checksums.sha2

basis/cocoa/enumeration/enumeration.factor

@@ -15,7 +15,7 @@ IN: cocoa.enumeration
     object state stackbuf count -> countByEnumeratingWithState:objects:count:
     dup zero? [ drop ] [
         state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
-        '[ , void*-nth quot call ] each
+        '[ _ void*-nth quot call ] each
         object quot state stackbuf count (NSFastEnumeration-each)
     ] if ; inline recursive
 
@@ -24,7 +24,7 @@ IN: cocoa.enumeration
 
 : NSFastEnumeration-map ( object quot -- vector )
     NS-EACH-BUFFER-SIZE <vector>
-    [ '[ @ , push ] NSFastEnumeration-each ] keep ; inline
+    [ '[ @ _ push ] NSFastEnumeration-each ] keep ; inline
 
 : NSFastEnumeration>vector ( object -- vector )
     [ ] NSFastEnumeration-map ;

basis/cocoa/messages/messages.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings
+USING: accessors alien alien.c-types alien.strings arrays assocs
-arrays assocs combinators compiler kernel
+combinators compiler kernel math namespaces make parser
-math namespaces parser prettyprint prettyprint.sections
+prettyprint prettyprint.sections quotations sequences strings
-quotations sequences strings words cocoa.runtime io macros
+words cocoa.runtime io macros memoize debugger
-memoize debugger io.encodings.ascii effects compiler.generator
+io.encodings.ascii effects compiler.generator libc libc.private ;
-libc libc.private ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )

basis/cocoa/subclassing/subclassing.factor

@@ -4,7 +4,7 @@ USING: alien alien.c-types alien.strings arrays assocs
 combinators compiler hashtables kernel libc math namespaces
 parser sequences words cocoa.messages cocoa.runtime
 compiler.units io.encodings.ascii generalizations
-continuations ;
+continuations make ;
 IN: cocoa.subclassing
 
 : init-method ( method -- sel imp types )

basis/cocoa/views/views.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays kernel math namespaces cocoa
+USING: alien.c-types arrays kernel math namespaces make cocoa
 cocoa.messages cocoa.classes cocoa.types sequences
 continuations ;
 IN: cocoa.views

basis/combinators/short-circuit/short-circuit.factor

@@ -11,7 +11,7 @@ IN: combinators.short-circuit
      [ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
    map
    [ t ] [ N nnip ] 2array suffix
-   '[ f , cond ] ;
+   '[ f _ cond ] ;
 
 MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
 MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
@@ -25,7 +25,7 @@ MACRO: 3&& ( quots -- quot ) 3 n&&-rewrite ;
      [ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
    map
    [ drop N ndrop t ] [ f ] 2array suffix
-   '[ f , cond ] ;
+   '[ f _ cond ] ;
 
 MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
 MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;

basis/compiler/compiler.factor

@@ -54,7 +54,7 @@ SYMBOL: +failed+
         H{ } clone dependencies set
         H{ } clone generic-dependencies set
 
-        , {
+        _ {
             [ compile-begins ]
             [
                 [ build-tree-from-word ] [ compile-failed return ] recover

basis/compiler/generator/fixup/fixup.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays byte-arrays generic assocs hashtables io.binary
-kernel kernel.private math namespaces sequences words
+kernel kernel.private math namespaces make sequences words
 quotations strings alien.accessors alien.strings layouts system
 combinators math.bitwise words.private cpu.architecture
 math.order accessors growable ;

basis/compiler/generator/generator.factor

@@ -1,15 +1,15 @@
- ! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs classes combinators
 cpu.architecture effects generic hashtables io kernel
-kernel.private layouts math math.parser namespaces prettyprint
+kernel.private layouts math math.parser namespaces make
-quotations sequences system threads words vectors sets deques
+prettyprint quotations sequences system threads words vectors
-continuations.private summary alien alien.c-types
+sets deques continuations.private summary alien alien.c-types
 alien.structs alien.strings alien.arrays libc compiler.errors
-stack-checker.inlining
+stack-checker.inlining compiler.tree compiler.tree.builder
-compiler.tree compiler.tree.builder compiler.tree.combinators
+compiler.tree.combinators compiler.tree.propagation.info
-compiler.tree.propagation.info compiler.generator.fixup
+compiler.generator.fixup compiler.generator.registers
-compiler.generator.registers compiler.generator.iterator ;
+compiler.generator.iterator ;
 IN: compiler.generator
 
 SYMBOL: compile-queue

basis/compiler/generator/registers/registers.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes classes.private classes.algebra
-combinators hashtables kernel layouts math namespaces quotations
+combinators hashtables kernel layouts math namespaces make
-sequences system vectors words effects alien byte-arrays
+quotations sequences system vectors words effects alien
-accessors sets math.order cpu.architecture
+byte-arrays accessors sets math.order cpu.architecture
 compiler.generator.fixup ;
 IN: compiler.generator.registers
 
@@ -50,13 +50,21 @@ C: <vreg> vreg ( n reg-class -- vreg )
 
 M: vreg v>operand [ n>> ] [ reg-class>> ] bi vregs nth ;
 M: vreg live-vregs* , ;
-M: vreg move-spec reg-class>> move-spec ;
+
+M: vreg move-spec
+    reg-class>> {
+        { [ dup int-regs? ] [ f ] }
+        { [ dup float-regs? ] [ float ] }
+    } cond nip ;
+
+M: vreg operand-class*
+    reg-class>> {
+        { [ dup int-regs? ] [ f ] }
+        { [ dup float-regs? ] [ float ] }
+    } cond nip ;
 
 INSTANCE: vreg value
 
-M: float-regs move-spec drop float ;
-M: float-regs operand-class* drop float ;
-
 ! Temporary register for stack shuffling
 SINGLETON: temp-reg
 

basis/compiler/tests/alien.factor

@@ -3,7 +3,7 @@ USING: alien alien.c-types alien.syntax compiler kernel
 namespaces namespaces tools.test sequences stack-checker
 stack-checker.errors words arrays parser quotations
 continuations effects namespaces.private io io.streams.string
-memory system threads tools.test math accessors ;
+memory system threads tools.test math accessors combinators ;
 
 FUNCTION: void ffi_test_0 ;
 [ ] [ ffi_test_0 ] unit-test
@@ -401,3 +401,41 @@ C-STRUCT: test_struct_13
 FUNCTION: int ffi_test_39 ( long a, long b, test_struct_13 s ) ;
 
 [ 21 ] [ 12347 12347 make-test-struct-13 ffi_test_39 ] unit-test
+
+! Joe Groff found this problem
+C-STRUCT: double-rect
+{ "double" "a" }
+{ "double" "b" }
+{ "double" "c" }
+{ "double" "d" } ;
+
+: <double-rect> ( a b c d -- foo )
+    "double-rect" <c-object>
+    {
+        [ set-double-rect-d ]
+        [ set-double-rect-c ]
+        [ set-double-rect-b ]
+        [ set-double-rect-a ]
+        [ ]
+    } cleave ;
+
+: >double-rect< ( foo -- a b c d )
+    {
+        [ double-rect-a ]
+        [ double-rect-b ]
+        [ double-rect-c ]
+        [ double-rect-d ]
+    } cleave ;
+
+: double-rect-callback ( -- alien )
+    "void" { "void*" "void*" "double-rect" } "cdecl"
+    [ "example" set-global 2drop ] alien-callback ;
+
+: double-rect-test ( arg -- arg' )
+    f f rot
+    double-rect-callback
+    "void" { "void*" "void*" "double-rect" } "cdecl" alien-indirect
+    "example" get-global ;
+
+[ 1.0 2.0 3.0 4.0 ]
+[ 1.0 2.0 3.0 4.0 <double-rect> double-rect-test >double-rect< ] unit-test

basis/compiler/tests/curry.factor

@@ -1,5 +1,5 @@
 USING: tools.test quotations math kernel sequences
-assocs namespaces compiler.units ;
+assocs namespaces make compiler.units ;
 IN: compiler.tests
 
 [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test

basis/compiler/tests/templates-early.factor

@@ -3,7 +3,7 @@ IN: compiler.tests
 USING: compiler compiler.generator compiler.generator.registers
 compiler.generator.registers.private tools.test namespaces
 sequences words kernel math effects definitions compiler.units
-accessors cpu.architecture ;
+accessors cpu.architecture make ;
 
 : <int-vreg> ( n -- vreg ) int-regs <vreg> ;
 

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

@@ -10,12 +10,13 @@ compiler.tree
 compiler.tree.combinators
 compiler.tree.cleanup
 compiler.tree.builder
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
 compiler.tree.checker ;
 
 : cleaned-up-tree ( quot -- nodes )
-    build-tree normalize propagate cleanup dup check-nodes ;
+    build-tree analyze-recursive normalize propagate cleanup dup check-nodes ;
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
 
@@ -36,7 +37,7 @@ compiler.tree.checker ;
 : inlined? ( quot seq/word -- ? )
     [ cleaned-up-tree ] dip
     dup word? [ 1array ] when
-    '[ dup #call? [ word>> , member? ] [ drop f ] if ]
+    '[ dup #call? [ word>> _ member? ] [ drop f ] if ]
     contains-node? not ;
 
 [ f ] [
@@ -457,3 +458,43 @@ cell-bits 32 = [
     [ [ >r "A" throw r> ] [ "B" throw ] if ]
     cleaned-up-tree drop
 ] unit-test
+
+! Regression from benchmark.nsieve
+: chicken-fingers ( i seq -- )
+    2dup < [
+        2drop
+    ] [
+        chicken-fingers
+    ] if ; inline recursive
+
+: buffalo-wings ( i seq -- )
+    2dup < [
+        2dup chicken-fingers
+        >r 1+ r> buffalo-wings
+    ] [
+        2drop
+    ] if ; inline recursive
+
+[ t ] [
+    [ 2 swap >fixnum buffalo-wings ]
+    { <-integer-fixnum +-integer-fixnum } inlined?
+] unit-test
+
+! A reduction
+: buffalo-sauce f ;
+
+: steak ( -- )
+    buffalo-sauce [ steak ] when ; inline recursive
+
+: ribs ( i seq -- )
+    2dup < [
+        steak
+        >r 1+ r> ribs
+    ] [
+        2drop
+    ] if ; inline recursive
+
+[ t ] [
+    [ 2 swap >fixnum ribs ]
+    { <-integer-fixnum +-integer-fixnum } inlined?
+] unit-test

basis/compiler/tree/cleanup/cleanup.factor

@@ -101,7 +101,7 @@ M: #declare cleanup* drop f ;
 
 : delete-unreachable-branches ( #branch -- )
     dup live-branches>> '[
-        ,
+        _
         [ [ [ drop ] [ delete-nodes ] if ] 2each ]
         [ select-children ]
         2bi
@@ -148,9 +148,9 @@ M: #branch cleanup*
 M: #phi cleanup*
     #! Remove #phi function inputs which no longer exist.
     live-branches get
-    [ '[ , sift-children ] change-phi-in-d ]
+    [ '[ _ sift-children ] change-phi-in-d ]
-    [ '[ , sift-children ] change-phi-info-d ]
+    [ '[ _ sift-children ] change-phi-info-d ]
-    [ '[ , sift-children ] change-terminated ] tri
+    [ '[ _ sift-children ] change-terminated ] tri
     eliminate-phi
     live-branches off ;
 

basis/compiler/tree/combinators/combinators.factor

@@ -6,12 +6,12 @@ IN: compiler.tree.combinators
 
 : each-node ( nodes quot: ( node -- ) -- )
     dup dup '[
-        , [
+        _ [
             dup #branch? [
-                children>> [ , each-node ] each
+                children>> [ _ each-node ] each
             ] [
                 dup #recursive? [
-                    child>> , each-node
+                    child>> _ each-node
                 ] [ drop ] if
             ] if
         ] bi
@@ -21,22 +21,22 @@ IN: compiler.tree.combinators
     dup dup '[
         @
         dup #branch? [
-            [ [ , map-nodes ] map ] change-children
+            [ [ _ map-nodes ] map ] change-children
         ] [
             dup #recursive? [
-                [ , map-nodes ] change-child
+                [ _ map-nodes ] change-child
             ] when
         ] if
     ] map flatten ; inline recursive
 
 : contains-node? ( nodes quot: ( node -- ? ) -- ? )
     dup dup '[
-        , keep swap [ drop t ] [
+        _ keep swap [ drop t ] [
             dup #branch? [
-                children>> [ , contains-node? ] contains?
+                children>> [ _ contains-node? ] contains?
             ] [
                 dup #recursive? [
-                    child>> , contains-node?
+                    child>> _ contains-node?
                 ] [ drop f ] if
             ] if
         ] if

basis/compiler/tree/dead-code/branches/branches.factor

@@ -33,7 +33,7 @@ M: #branch remove-dead-code*
 
 : live-value-indices ( values -- indices )
     [ length ] keep live-values get
-    '[ , nth , key? ] filter ; inline
+    '[ _ nth _ key? ] filter ; inline
 
 : drop-indexed-values ( values indices -- node )
     [ drop filter-live ] [ nths ] 2bi
@@ -44,13 +44,13 @@ M: #branch remove-dead-code*
 : insert-drops ( nodes values indices -- nodes' )
     '[
         over ends-with-terminate?
-        [ drop ] [ , drop-indexed-values suffix ] if
+        [ drop ] [ _ drop-indexed-values suffix ] if
     ] 2map ;
 
 : hoist-drops ( #phi -- )
     if-node get swap
     [ phi-in-d>> ] [ out-d>> live-value-indices ] bi
-    '[ , , insert-drops ] change-children drop ;
+    '[ _ _ insert-drops ] change-children drop ;
 
 : remove-phi-outputs ( #phi -- )
     [ filter-live ] change-out-d drop ;

basis/compiler/tree/dead-code/dead-code-tests.factor

@@ -3,16 +3,17 @@ compiler.tree.dead-code compiler.tree.def-use compiler.tree
 compiler.tree.combinators compiler.tree.propagation
 compiler.tree.cleanup compiler.tree.escape-analysis
 compiler.tree.tuple-unboxing compiler.tree.debugger
-compiler.tree.normalization compiler.tree.checker tools.test
+compiler.tree.recursive compiler.tree.normalization
-kernel math stack-checker.state accessors combinators io
+compiler.tree.checker tools.test kernel math stack-checker.state
-prettyprint words sequences.deep sequences.private arrays
+accessors combinators io prettyprint words sequences.deep
-classes kernel.private ;
+sequences.private arrays classes kernel.private ;
 IN: compiler.tree.dead-code.tests
 
 \ remove-dead-code must-infer
 
 : count-live-values ( quot -- n )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup
@@ -64,6 +65,7 @@ IN: compiler.tree.dead-code.tests
 
 : optimize-quot ( quot -- quot' )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup

basis/compiler/tree/dead-code/simple/simple.factor

@@ -53,7 +53,7 @@ M: #alien-invoke compute-live-values* nip look-at-inputs ;
 M: #alien-indirect compute-live-values* nip look-at-inputs ;
 
 : filter-mapping ( assoc -- assoc' )
-    live-values get '[ drop , key? ] assoc-filter ;
+    live-values get '[ drop _ key? ] assoc-filter ;
 
 : filter-corresponding ( new old -- old' )
     #! Remove elements from 'old' if the element with the same

basis/compiler/tree/debugger/debugger.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs fry match accessors namespaces effects
+USING: kernel assocs fry match accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.sections math words
 combinators io sorting hints
@@ -16,7 +16,7 @@ IN: compiler.tree.debugger
 GENERIC: node>quot ( node -- )
 
 MACRO: match-choose ( alist -- )
-    [ '[ , ] ] assoc-map '[ , match-cond ] ;
+    [ [ ] curry ] assoc-map [ match-cond ] curry ;
 
 MATCH-VARS: ?a ?b ?c ;
 

basis/compiler/tree/def-use/def-use-tests.factor

@@ -1,9 +1,10 @@
 USING: accessors namespaces assocs kernel sequences math
 tools.test words sets combinators.short-circuit
 stack-checker.state compiler.tree compiler.tree.builder
-compiler.tree.normalization compiler.tree.propagation
+compiler.tree.recursive compiler.tree.normalization
-compiler.tree.cleanup compiler.tree.def-use arrays kernel.private
+compiler.tree.propagation compiler.tree.cleanup
-sorting math.order binary-search compiler.tree.checker ;
+compiler.tree.def-use arrays kernel.private sorting math.order
+binary-search compiler.tree.checker ;
 IN: compiler.tree.def-use.tests
 
 \ compute-def-use must-infer
@@ -18,6 +19,7 @@ IN: compiler.tree.def-use.tests
 
 : test-def-use ( quot -- )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup
@@ -27,7 +29,14 @@ IN: compiler.tree.def-use.tests
 : too-deep ( a b -- c )
     dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive
 
-[ ] [ [ too-deep ] build-tree normalize compute-def-use check-nodes ] unit-test
+[ ] [
+    [ too-deep ]
+    build-tree
+    analyze-recursive
+    normalize
+    compute-def-use
+    check-nodes
+] unit-test
 
 ! compute-def-use checks for SSA violations, so we use that to
 ! ensure we generate some common patterns correctly.

basis/compiler/tree/escape-analysis/escape-analysis-tests.factor

@@ -1,13 +1,14 @@
 IN: compiler.tree.escape-analysis.tests
 USING: compiler.tree.escape-analysis
 compiler.tree.escape-analysis.allocations compiler.tree.builder
-compiler.tree.normalization math.functions
+compiler.tree.recursive compiler.tree.normalization
-compiler.tree.propagation compiler.tree.cleanup
+math.functions compiler.tree.propagation compiler.tree.cleanup
-compiler.tree.combinators compiler.tree sequences math math.private
+compiler.tree.combinators compiler.tree sequences math
-kernel tools.test accessors slots.private quotations.private
+math.private kernel tools.test accessors slots.private
-prettyprint classes.tuple.private classes classes.tuple
+quotations.private prettyprint classes.tuple.private classes
-compiler.intrinsics namespaces compiler.tree.propagation.info
+classes.tuple compiler.intrinsics namespaces
-stack-checker.errors kernel.private ;
+compiler.tree.propagation.info stack-checker.errors
+kernel.private ;
 
 \ escape-analysis must-infer
 
@@ -28,6 +29,7 @@ M: node count-unboxed-allocations* drop ;
 
 : count-unboxed-allocations ( quot -- sizes )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup

basis/compiler/tree/escape-analysis/recursive/recursive.factor

@@ -28,7 +28,7 @@ IN: compiler.tree.escape-analysis.recursive
 
 : recursive-stacks ( #enter-recursive -- stacks )
     recursive-phi-in
-    escaping-values get '[ [ , disjoint-set-member? ] all? ] filter
+    escaping-values get '[ [ _ disjoint-set-member? ] all? ] filter
     flip ;
 
 : analyze-recursive-phi ( #enter-recursive -- )
@@ -67,5 +67,5 @@ M: #return-recursive escape-analysis* ( #return-recursive -- )
     [ call-next-method ]
     [
         [ in-d>> ] [ label>> calls>> ] bi
-        [ out-d>> escaping-values get '[ , equate ] 2each ] with each
+        [ out-d>> escaping-values get '[ _ equate ] 2each ] with each
     ] bi ;

basis/compiler/tree/finalization/finalization.factor

@@ -1,12 +1,13 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays accessors sequences sequences.private words
-fry namespaces math math.order memoize classes.builtin
+fry namespaces make math math.order memoize classes.builtin
 classes.tuple.private slots.private combinators layouts
 byte-arrays alien.accessors
 compiler.intrinsics
 compiler.tree
 compiler.tree.builder
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
 compiler.tree.propagation.info
@@ -39,6 +40,7 @@ M: #shuffle finalize*
 : splice-quot ( quot -- nodes )
     [
         build-tree
+        analyze-recursive 
         normalize
         propagate
         cleanup
@@ -68,7 +70,7 @@ MEMO: builtin-predicate-expansion ( word -- nodes )
 MEMO: (tuple-boa-expansion) ( n -- quot )
     [
         [ 2 + ] map <reversed>
-        [ '[ [ , set-slot ] keep ] % ] each
+        [ '[ [ _ set-slot ] keep ] % ] each
     ] [ ] make ;
 
 : tuple-boa-expansion ( layout -- quot )

basis/compiler/tree/identities/identities.factor

@@ -0,0 +1,98 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel sequences fry words math
+math.partial-dispatch combinators arrays hashtables
+compiler.tree
+compiler.tree.combinators
+compiler.tree.propagation.info ;
+IN: compiler.tree.identities
+
+: define-identities ( word identities -- )
+    [ integer-derived-ops ] dip
+    '[ _ "identities" set-word-prop ] each ;
+
+SYMBOL: X
+
+\ + {
+    { { X 0 } drop }
+    { { 0 X } nip }
+} define-identities
+
+\ - {
+    { { X 0 } drop }
+} define-identities
+
+\ * {
+    { { X 1 } drop }
+    { { 1 X } nip }
+    { { X 0 } nip }
+    { { 0 X } drop }
+} define-identities
+
+\ / {
+    { { X 1 } drop }
+} define-identities
+
+\ mod {
+    { { X 1 } 0 }
+} define-identities
+
+\ rem {
+    { { X 1 } 0 }
+} define-identities
+
+\ bitand {
+    { { X -1 } drop }
+    { { -1 X } nip }
+    { { X 0 } nip }
+    { { 0 X } drop }
+} define-identities
+
+\ bitor {
+    { { X 0 } drop }
+    { { 0 X } nip }
+    { { X -1 } nip }
+    { { -1 X } drop }
+} define-identities
+
+\ bitxor {
+    { { X 0 } drop }
+    { { 0 X } nip }
+} define-identities
+
+\ shift {
+    { { 0 X } drop }
+    { { X 0 } drop }
+} define-identities
+
+: matches? ( pattern infos -- ? )
+    [ over X eq? [ 2drop t ] [ literal>> = ] if ] 2all? ;
+
+: find-identity ( patterns infos -- result )
+    '[ first _ matches? ] find swap [ second ] when ;
+
+GENERIC: apply-identities* ( node -- node )
+
+: simplify-to-constant ( #call constant -- nodes )
+    [ [ in-d>> #drop ] [ out-d>> first ] bi ] dip swap #push
+    2array ;
+
+: select-input ( node n -- #shuffle )
+    [ [ in-d>> ] [ out-d>> ] bi ] dip
+    pick nth over first associate #shuffle ;
+
+M: #call apply-identities*
+    dup word>> "identities" word-prop [
+        over node-input-infos find-identity [
+            {
+                { \ drop [ 0 select-input ] }
+                { \ nip [ 1 select-input ] }
+                [ simplify-to-constant ]
+            } case
+        ] when*
+    ] when* ;
+
+M: node apply-identities* ;
+
+: apply-identities ( nodes -- nodes' )
+    [ apply-identities* ] map-nodes ;

basis/compiler/tree/normalization/introductions/introductions.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces sequences accessors math kernel
+compiler.tree ;
+IN: compiler.tree.normalization.introductions
+
+SYMBOL: introductions
+
+GENERIC: count-introductions* ( node -- )
+
+: count-introductions ( nodes -- n )
+    #! Note: we use each, not each-node, since the #branch
+    #! method recurses into children directly and we don't
+    #! recurse into #recursive at all.
+    [
+        0 introductions set
+        [ count-introductions* ] each
+        introductions get
+    ] with-scope ;
+
+: introductions+ ( n -- ) introductions [ + ] change ;
+
+M: #introduce count-introductions*
+    out-d>> length introductions+ ;
+
+M: #branch count-introductions*
+    children>>
+    [ count-introductions ] map supremum
+    introductions+ ;
+
+M: #recursive count-introductions*
+    [ label>> ] [ child>> count-introductions ] bi
+    >>introductions
+    drop ;
+
+M: node count-introductions* drop ;

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

@@ -1,5 +1,8 @@
 IN: compiler.tree.normalization.tests
-USING: compiler.tree.builder compiler.tree.normalization
+USING: compiler.tree.builder compiler.tree.recursive
+compiler.tree.normalization
+compiler.tree.normalization.introductions
+compiler.tree.normalization.renaming
 compiler.tree compiler.tree.checker
 sequences accessors tools.test kernel math ;
 
@@ -22,27 +25,30 @@ sequences accessors tools.test kernel math ;
 [ 0 2 ] [
     [ foo ] build-tree
     [ recursive-inputs ]
-    [ normalize recursive-inputs ] bi
+    [ analyze-recursive normalize recursive-inputs ] bi
 ] unit-test
 
-[ ] [ [ [ 1 ] [ 2 ] if + * ] build-tree normalize check-nodes ] unit-test
+: test-normalization ( quot -- )
+    build-tree analyze-recursive normalize check-nodes ;
+
+[ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
 
 DEFER: bbb
 : aaa ( x -- ) dup [ dup >r bbb r> aaa ] [ drop ] if ; inline recursive
 : bbb ( x -- ) >r drop 0 r> aaa ; inline recursive
 
-[ ] [ [ bbb ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ bbb ] test-normalization ] unit-test
 
 : ccc ( -- ) ccc drop 1 ; inline recursive
 
-[ ] [ [ ccc ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ ccc ] test-normalization ] unit-test
 
 DEFER: eee
 : ddd ( -- ) eee ; inline recursive
 : eee ( -- ) swap ddd ; inline recursive
 
-[ ] [ [ eee ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ eee ] test-normalization ] unit-test
 
 : call-recursive-5 ( -- ) call-recursive-5 ; inline recursive
 
-[ ] [ [ call-recursive-5 swap ] build-tree normalize check-nodes ] unit-test
+[ ] [ [ call-recursive-5 swap ] test-normalization ] unit-test

basis/compiler/tree/normalization/normalization.factor

@@ -6,7 +6,9 @@ stack-checker.backend
 stack-checker.branches
 stack-checker.inlining
 compiler.tree
-compiler.tree.combinators ;
+compiler.tree.combinators
+compiler.tree.normalization.introductions
+compiler.tree.normalization.renaming ;
 IN: compiler.tree.normalization
 
 ! A transform pass done before optimization can begin to
@@ -16,9 +18,6 @@ IN: compiler.tree.normalization
 ! replaced with a single one, at the beginning of a program.
 ! This simplifies subsequent analysis.
 !
-! - We collect #return-recursive and #call-recursive nodes and
-! store them in the #recursive's label slot.
-!
 ! - We normalize #call-recursive as follows. The stack checker
 ! says that the inputs of a #call-recursive are the entire stack
 ! at the time of the call. This is a conservative estimate; we
@@ -28,93 +27,6 @@ IN: compiler.tree.normalization
 ! #call-recursive into a #copy of the unchanged values and a
 ! #call-recursive with trimmed inputs and outputs.
 
-! Collect introductions
-SYMBOL: introductions
-
-GENERIC: count-introductions* ( node -- )
-
-: count-introductions ( nodes -- n )
-    #! Note: we use each, not each-node, since the #branch
-    #! method recurses into children directly and we don't
-    #! recurse into #recursive at all.
-    [
-        0 introductions set
-        [ count-introductions* ] each
-        introductions get
-    ] with-scope ;
-
-: introductions+ ( n -- ) introductions [ + ] change ;
-
-M: #introduce count-introductions*
-    out-d>> length introductions+ ;
-
-M: #branch count-introductions*
-    children>>
-    [ count-introductions ] map supremum
-    introductions+ ;
-
-M: #recursive count-introductions*
-    [ label>> ] [ child>> count-introductions ] bi
-    >>introductions
-    drop ;
-
-M: node count-introductions* drop ;
-
-! Collect label info
-GENERIC: collect-label-info ( node -- )
-
-M: #return-recursive collect-label-info
-    dup label>> (>>return) ;
-
-M: #call-recursive collect-label-info
-    dup label>> calls>> push ;
-
-M: #recursive collect-label-info
-    label>> V{ } clone >>calls drop ;
-
-M: node collect-label-info drop ;
-
-! Rename
-SYMBOL: rename-map
-
-: rename-value ( value -- value' )
-    [ rename-map get at ] keep or ;
-
-: rename-values ( values -- values' )
-    rename-map get '[ [ , at ] keep or ] map ;
-
-GENERIC: rename-node-values* ( node -- node )
-
-M: #introduce rename-node-values* ;
-
-M: #shuffle rename-node-values*
-    [ rename-values ] change-in-d
-    [ [ rename-value ] assoc-map ] change-mapping ;
-
-M: #push rename-node-values* ;
-
-M: #r> rename-node-values*
-    [ rename-values ] change-in-r ;
-
-M: #terminate rename-node-values*
-    [ rename-values ] change-in-d
-    [ rename-values ] change-in-r ;
-
-M: #phi rename-node-values*
-    [ [ rename-values ] map ] change-phi-in-d ;
-
-M: #declare rename-node-values*
-    [ [ [ rename-value ] dip ] assoc-map ] change-declaration ;
-
-M: #alien-callback rename-node-values* ;
-
-M: node rename-node-values*
-    [ rename-values ] change-in-d ;
-
-: rename-node-values ( nodes -- nodes' )
-    dup [ rename-node-values* drop ] each-node ;
-
-! Normalize
 GENERIC: normalize* ( node -- node' )
 
 SYMBOL: introduction-stack
@@ -125,10 +37,6 @@ SYMBOL: introduction-stack
 : pop-introductions ( n -- values )
     introduction-stack [ swap cut* swap ] change ;
 
-: add-renamings ( old new -- )
-    [ rename-values ] dip
-    rename-map get '[ , set-at ] 2each ;
-
 M: #introduce normalize*
     out-d>> [ length pop-introductions ] keep add-renamings f ;
 
@@ -158,7 +66,7 @@ M: #branch normalize*
 
 M: #phi normalize*
     remaining-introductions get swap dup terminated>>
-    '[ , eliminate-phi-introductions ] change-phi-in-d ;
+    '[ _ eliminate-phi-introductions ] change-phi-in-d ;
 
 : (normalize) ( nodes introductions -- nodes )
     introduction-stack [
@@ -168,7 +76,7 @@ M: #phi normalize*
 M: #recursive normalize*
     dup label>> introductions>>
     [ drop [ child>> first ] [ in-d>> ] bi >>in-d drop ]
-    [ make-values '[ , (normalize) ] change-child ]
+    [ make-values '[ _ (normalize) ] change-child ]
     2bi ;
 
 M: #enter-recursive normalize*
@@ -181,14 +89,14 @@ M: #enter-recursive normalize*
 
 : call<return ( #call-recursive n -- nodes )
     neg dup make-values [
-        [ pop-introductions '[ , prepend ] change-in-d ]
+        [ pop-introductions '[ _ prepend ] change-in-d ]
-        [ '[ , prepend ] change-out-d ]
+        [ '[ _ prepend ] change-out-d ]
         bi*
     ] [ introduction-stack [ prepend ] change ] bi ;
 
 : call>return ( #call-recursive n -- #call-recursive )
-    [ [ [ in-d>> ] [ out-d>> ] bi ] [ '[ , head ] ] bi* bi@ add-renamings ]
+    [ [ [ in-d>> ] [ out-d>> ] bi ] [ '[ _ head ] ] bi* bi@ add-renamings ]
-    [ '[ , tail ] [ change-in-d ] [ change-out-d ] bi ]
+    [ '[ _ tail ] [ change-in-d ] [ change-out-d ] bi ]
     2bi ;
 
 M: #call-recursive normalize*
@@ -201,9 +109,8 @@ M: #call-recursive normalize*
 M: node normalize* ;
 
 : normalize ( nodes -- nodes' )
-    H{ } clone rename-map set
-    dup [ collect-label-info ] each-node
     dup count-introductions make-values
+    H{ } clone rename-map set
     [ (normalize) ] [ nip ] 2bi
     [ #introduce prefix ] unless-empty
     rename-node-values ;

basis/compiler/tree/normalization/renaming/renaming.factor

@@ -0,0 +1,48 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces assocs kernel accessors sequences fry
+compiler.tree compiler.tree.combinators ;
+IN: compiler.tree.normalization.renaming
+
+SYMBOL: rename-map
+
+: rename-value ( value -- value' )
+    [ rename-map get at ] keep or ;
+
+: rename-values ( values -- values' )
+    rename-map get '[ [ _ at ] keep or ] map ;
+
+: add-renamings ( old new -- )
+    [ rename-values ] dip
+    rename-map get '[ _ set-at ] 2each ;
+
+GENERIC: rename-node-values* ( node -- node )
+
+M: #introduce rename-node-values* ;
+
+M: #shuffle rename-node-values*
+    [ rename-values ] change-in-d
+    [ [ rename-value ] assoc-map ] change-mapping ;
+
+M: #push rename-node-values* ;
+
+M: #r> rename-node-values*
+    [ rename-values ] change-in-r ;
+
+M: #terminate rename-node-values*
+    [ rename-values ] change-in-d
+    [ rename-values ] change-in-r ;
+
+M: #phi rename-node-values*
+    [ [ rename-values ] map ] change-phi-in-d ;
+
+M: #declare rename-node-values*
+    [ [ [ rename-value ] dip ] assoc-map ] change-declaration ;
+
+M: #alien-callback rename-node-values* ;
+
+M: node rename-node-values*
+    [ rename-values ] change-in-d ;
+
+: rename-node-values ( nodes -- nodes' )
+    dup [ rename-node-values* drop ] each-node ;

basis/compiler/tree/optimizer/optimizer.factor

@@ -1,15 +1,16 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces
+compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
 compiler.tree.cleanup
 compiler.tree.escape-analysis
 compiler.tree.tuple-unboxing
+compiler.tree.identities
 compiler.tree.def-use
 compiler.tree.dead-code
 compiler.tree.strength-reduction
-compiler.tree.loop.detection
 compiler.tree.finalization
 compiler.tree.checker ;
 IN: compiler.tree.optimizer
@@ -17,12 +18,13 @@ IN: compiler.tree.optimizer
 SYMBOL: check-optimizer?
 
 : optimize-tree ( nodes -- nodes' )
+    analyze-recursive
     normalize
     propagate
     cleanup
-    detect-loops
     escape-analysis
     unbox-tuples
+    apply-identities
     compute-def-use
     remove-dead-code
     ! strength-reduce

basis/compiler/tree/propagation/branches/branches.factor

@@ -32,7 +32,7 @@ M: #if live-branches
 
 M: #dispatch live-branches
     [ children>> length ] [ in-d>> first value-info interval>> ] bi
-    '[ , interval-contains? ] map ;
+    '[ _ interval-contains? ] map ;
 
 : live-children ( #branch -- children )
     [ children>> ] [ live-branches>> ] bi select-children ;
@@ -61,7 +61,7 @@ SYMBOL: infer-children-data
     infer-children-data get
     [
         '[
-            , [
+            _ [
                 dup +bottom+ eq?
                 [ drop null-info ] [ value-info ] if
             ] bind

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -6,11 +6,20 @@ classes.algebra classes.union sets quotations assocs combinators
 words namespaces
 compiler.tree
 compiler.tree.builder
+compiler.tree.recursive
+compiler.tree.combinators
 compiler.tree.normalization
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes ;
 IN: compiler.tree.propagation.inlining
 
+! We count nodes up-front; if there are relatively few nodes,
+! we are more eager to inline
+SYMBOL: node-count
+
+: count-nodes ( nodes -- )
+    0 swap [ drop 1+ ] each-node node-count set ;
+
 ! Splicing nodes
 GENERIC: splicing-nodes ( #call word/quot/f -- nodes )
 
@@ -18,7 +27,7 @@ M: word splicing-nodes
     [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
 
 M: quotation splicing-nodes
-    build-sub-tree normalize ;
+    build-sub-tree analyze-recursive normalize ;
 
 : propagate-body ( #call -- )
     body>> (propagate) ;
@@ -113,12 +122,13 @@ DEFER: (flat-length)
     [ classes-known? 2 0 ? ]
     [
         {
+            [ drop node-count get 45 swap [-] 8 /i ]
             [ flat-length 24 swap [-] 4 /i ]
             [ "default" word-prop -4 0 ? ]
             [ "specializer" word-prop 1 0 ? ]
             [ method-body? 1 0 ? ]
         } cleave
-    ] bi* + + + + ;
+    ] bi* + + + + + ;
 
 : should-inline? ( #call word -- ? )
     inlining-rank 5 >= ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -118,7 +118,7 @@ most-negative-fixnum most-positive-fixnum [a,b]
 
 : binary-op ( word interval-quot post-proc-quot -- )
     '[
-        [ binary-op-class ] [ , binary-op-interval ] 2bi
+        [ binary-op-class ] [ _ binary-op-interval ] 2bi
         @
         <class/interval-info>
     ] "outputs" set-word-prop ;
@@ -159,14 +159,14 @@ most-negative-fixnum most-positive-fixnum [a,b]
     in1 in2 op negate-comparison (comparison-constraints) out f--> /\ ;
 
 : define-comparison-constraints ( word op -- )
-    '[ , comparison-constraints ] "constraints" set-word-prop ;
+    '[ _ comparison-constraints ] "constraints" set-word-prop ;
 
 comparison-ops
-[ dup '[ , define-comparison-constraints ] each-derived-op ] each
+[ dup '[ _ define-comparison-constraints ] each-derived-op ] each
 
 generic-comparison-ops [
     dup specific-comparison
-    '[ , , define-comparison-constraints ] each-derived-op
+    '[ _ _ define-comparison-constraints ] each-derived-op
 ] each
 
 ! Remove redundant comparisons
@@ -179,13 +179,13 @@ generic-comparison-ops [
 
 comparison-ops [
     dup '[
-        [ , fold-comparison ] "outputs" set-word-prop
+        [ _ fold-comparison ] "outputs" set-word-prop
     ] each-derived-op
 ] each
 
 generic-comparison-ops [
     dup specific-comparison
-    '[ , fold-comparison ] "outputs" set-word-prop
+    '[ _ fold-comparison ] "outputs" set-word-prop
 ] each
 
 : maybe-or-never ( ? -- info )
@@ -221,7 +221,7 @@ generic-comparison-ops [
     { >float float }
 } [
     '[
-        ,
+        _
         [ nip ] [
             [ interval>> ] [ class-interval ] bi*
             interval-intersect

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

@@ -1,5 +1,5 @@
 USING: kernel compiler.tree.builder compiler.tree
-compiler.tree.propagation
+compiler.tree.propagation compiler.tree.recursive
 compiler.tree.normalization tools.test math math.order
 accessors sequences arrays kernel.private vectors
 alien.accessors alien.c-types sequences.private
@@ -14,6 +14,7 @@ IN: compiler.tree.propagation.tests
 
 : final-info ( quot -- seq )
     build-tree
+    analyze-recursive
     normalize
     propagate
     compute-def-use

basis/compiler/tree/propagation/propagation.factor

@@ -6,6 +6,7 @@ compiler.tree.propagation.copy
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
 compiler.tree.propagation.simple
+compiler.tree.propagation.inlining
 compiler.tree.propagation.branches
 compiler.tree.propagation.recursive
 compiler.tree.propagation.constraints
@@ -18,4 +19,5 @@ IN: compiler.tree.propagation
     H{ } clone copies set
     H{ } clone constraints set
     H{ } clone value-infos set
+    dup count-nodes
     dup (propagate) ;

basis/compiler/tree/propagation/recursive/recursive.factor

@@ -70,7 +70,8 @@ M: #recursive propagate-around ( #recursive -- )
     [ generalize-return-interval ] map ;
 
 : return-infos ( node -- infos )
-    label>> return>> node-input-infos generalize-return ;
+    label>> [ return>> node-input-infos ] [ loop?>> ] bi
+    [ generalize-return ] unless ;
 
 M: #call-recursive propagate-before ( #call-recursive -- )
     [ ] [ return-infos ] [ node-output-infos ] tri

basis/compiler/tree/propagation/simple/simple.factor

@@ -68,8 +68,8 @@ M: #declare propagate-before
     [ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ;
 
 : (fold-call) ( #call word -- info )
-    [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ , execute ] ] bi*
+    [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi*
-    '[ , , with-datastack [ <literal-info> ] map nip ]
+    '[ _ _ with-datastack [ <literal-info> ] map nip ]
     [ drop [ object-info ] replicate ]
     recover ;
 

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

@@ -1,5 +1,5 @@
-IN: compiler.tree.loop.detection.tests
+IN: compiler.tree.recursive.tests
-USING: compiler.tree.loop.detection tools.test
+USING: compiler.tree.recursive tools.test
 kernel combinators.short-circuit math sequences accessors
 compiler.tree
 compiler.tree.builder
@@ -10,7 +10,7 @@ compiler.tree.combinators ;
 [ { f t t t } ] [ t { f f t t } (tail-calls) ] unit-test
 [ { f f f t } ] [ t { f f t f } (tail-calls) ] unit-test
 
-\ detect-loops must-infer
+\ analyze-recursive must-infer
 
 : label-is-loop? ( nodes word -- ? )
     [
@@ -38,22 +38,22 @@ compiler.tree.combinators ;
     dup [ 1+ loop-test-1 ] [ drop ] if ; inline recursive
                           
 [ t ] [
-    [ loop-test-1 ] build-tree detect-loops
+    [ loop-test-1 ] build-tree analyze-recursive
     \ loop-test-1 label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ loop-test-1 1 2 3 ] build-tree detect-loops
+    [ loop-test-1 1 2 3 ] build-tree analyze-recursive
     \ loop-test-1 label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ [ loop-test-1 ] each ] build-tree detect-loops
+    [ [ loop-test-1 ] each ] build-tree analyze-recursive
     \ loop-test-1 label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ [ loop-test-1 ] each ] build-tree detect-loops
+    [ [ loop-test-1 ] each ] build-tree analyze-recursive
     \ (each-integer) label-is-loop?
 ] unit-test
 
@@ -61,7 +61,7 @@ compiler.tree.combinators ;
     dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive
 
 [ t ] [
-    [ loop-test-2 ] build-tree detect-loops
+    [ loop-test-2 ] build-tree analyze-recursive
     \ loop-test-2 label-is-not-loop?
 ] unit-test
 
@@ -69,7 +69,7 @@ compiler.tree.combinators ;
     dup [ [ loop-test-3 ] each ] [ drop ] if ; inline recursive
 
 [ t ] [
-    [ loop-test-3 ] build-tree detect-loops
+    [ loop-test-3 ] build-tree analyze-recursive
     \ loop-test-3 label-is-not-loop?
 ] unit-test
 
@@ -81,7 +81,7 @@ compiler.tree.combinators ;
     ] if ; inline recursive
 
 [ f ] [
-    [ [ [ ] map ] map ] build-tree detect-loops
+    [ [ [ ] map ] map ] build-tree analyze-recursive
     [
         dup #recursive? [ label>> loop?>> not ] [ drop f ] if
     ] contains-node?
@@ -98,22 +98,22 @@ DEFER: a
     blah [ b ] [ a ] if ; inline recursive
 
 [ t ] [
-    [ a ] build-tree detect-loops
+    [ a ] build-tree analyze-recursive
     \ a label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ a ] build-tree detect-loops
+    [ a ] build-tree analyze-recursive
     \ b label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ b ] build-tree detect-loops
+    [ b ] build-tree analyze-recursive
     \ a label-is-loop?
 ] unit-test
 
 [ t ] [
-    [ a ] build-tree detect-loops
+    [ a ] build-tree analyze-recursive
     \ b label-is-loop?
 ] unit-test
 
@@ -126,12 +126,12 @@ DEFER: a'
     blah [ b' ] [ a' ] if ; inline recursive
 
 [ f ] [
-    [ a' ] build-tree detect-loops
+    [ a' ] build-tree analyze-recursive
     \ a' label-is-loop?
 ] unit-test
 
 [ f ] [
-    [ b' ] build-tree detect-loops
+    [ b' ] build-tree analyze-recursive
     \ b' label-is-loop?
 ] unit-test
 
@@ -140,11 +140,11 @@ DEFER: a'
 ! sound.
 
 [ t ] [
-    [ b' ] build-tree detect-loops
+    [ b' ] build-tree analyze-recursive
     \ a' label-is-loop?
 ] unit-test
 
 [ f ] [
-    [ a' ] build-tree detect-loops
+    [ a' ] build-tree analyze-recursive
     \ b' label-is-loop?
 ] unit-test

basis/compiler/tree/recursive/recursive.factor

@@ -1,14 +1,27 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces assocs accessors fry
+USING: kernel assocs namespaces accessors sequences deques
-compiler.tree deques search-deques ;
+search-deques compiler.tree compiler.tree.combinators ;
-IN: compiler.tree.loop.detection
+IN: compiler.tree.recursive
+
+! Collect label info
+GENERIC: collect-label-info ( node -- )
+
+M: #return-recursive collect-label-info
+    dup label>> (>>return) ;
+
+M: #call-recursive collect-label-info
+    dup label>> calls>> push ;
+
+M: #recursive collect-label-info
+    label>> V{ } clone >>calls drop ;
+
+M: node collect-label-info drop ;
 
 ! A loop is a #recursive which only tail calls itself, and those
 ! calls are nested inside other loops only. We optimistically
 ! assume all #recursive nodes are loops, disqualifying them as
 ! we see evidence to the contrary.
-
 : (tail-calls) ( tail? seq -- seq' )
     reverse [ swap [ and ] keep ] map nip reverse ;
 
@@ -84,5 +97,6 @@ M: node collect-loop-info* 2drop ;
         ] [ drop ] if
     ] slurp-deque ;
 
-: detect-loops ( nodes -- nodes )
+: analyze-recursive ( nodes -- nodes )
+    dup [ collect-label-info ] each-node
     dup collect-loop-info disqualify-loops ;

basis/compiler/tree/tree.factor

@@ -178,7 +178,7 @@ M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
 
 : shuffle-effect ( #shuffle -- effect )
     [ in-d>> ] [ out-d>> ] [ mapping>> ] tri
-    '[ , at ] map
+    '[ _ at ] map
     <effect> ;
 
 : recursive-phi-in ( #enter-recursive -- seq )

basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor

@@ -1,16 +1,18 @@
 IN: compiler.tree.tuple-unboxing.tests
 USING: tools.test compiler.tree.tuple-unboxing compiler.tree
-compiler.tree.builder compiler.tree.normalization
+compiler.tree.builder compiler.tree.recursive
-compiler.tree.propagation compiler.tree.cleanup
+compiler.tree.normalization compiler.tree.propagation
-compiler.tree.escape-analysis compiler.tree.tuple-unboxing
+compiler.tree.cleanup compiler.tree.escape-analysis
-compiler.tree.checker compiler.tree.def-use kernel accessors
+compiler.tree.tuple-unboxing compiler.tree.checker
-sequences math math.private sorting math.order binary-search
+compiler.tree.def-use kernel accessors sequences math
-sequences.private slots.private ;
+math.private sorting math.order binary-search sequences.private
+slots.private ;
 
 \ unbox-tuples must-infer
 
 : test-unboxing ( quot -- )
     build-tree
+    analyze-recursive
     normalize
     propagate
     cleanup

basis/concurrency/messaging/messaging-tests.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2005 Chris Double. All Rights Reserved.
 ! See http://factorcode.org/license.txt for BSD license.
-!
+USING: kernel threads vectors arrays sequences namespaces make
-USING: kernel threads vectors arrays sequences
+tools.test continuations deques strings math words match
-namespaces tools.test continuations deques strings math words
+quotations concurrency.messaging concurrency.mailboxes
-match quotations concurrency.messaging concurrency.mailboxes
 concurrency.count-downs accessors ;
 IN: concurrency.messaging.tests
 

basis/core-foundation/fsevents/fsevents.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences namespaces assocs init accessors continuations
+math sequences namespaces make assocs init accessors
-combinators core-foundation core-foundation.run-loop
+continuations combinators core-foundation
-io.encodings.utf8 destructors ;
+core-foundation.run-loop io.encodings.utf8 destructors ;
 IN: core-foundation.fsevents
 
 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !

basis/cpu/architecture/architecture.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic kernel kernel.private math memory
-namespaces sequences layouts system hashtables classes alien
+namespaces make sequences layouts system hashtables classes
-byte-arrays combinators words sets ;
+alien byte-arrays combinators words sets ;
 IN: cpu.architecture
 
 ! Register classes

basis/cpu/ppc/architecture/architecture.factor

@@ -5,7 +5,7 @@ cpu.architecture generic kernel kernel.private math memory
 namespaces sequences words assocs compiler.generator
 compiler.generator.registers compiler.generator.fixup system
 layouts classes words.private alien combinators
-compiler.constants math.order ;
+compiler.constants math.order make ;
 IN: cpu.ppc.architecture
 
 ! PowerPC register assignments

basis/cpu/ppc/assembler/assembler-tests.factor

@@ -1,6 +1,6 @@
 IN: cpu.ppc.assembler.tests
 USING: cpu.ppc.assembler tools.test arrays kernel namespaces
-vocabs sequences ;
+make vocabs sequences ;
 
 : test-assembler ( expected quot -- )
     [ 1array ] [ [ { } make ] curry ] bi* unit-test ;

basis/cpu/ppc/assembler/backend/backend.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler.generator.fixup kernel namespaces sequences
+USING: compiler.generator.fixup kernel namespaces make sequences
 words math math.bitwise io.binary parser lexer ;
 IN: cpu.ppc.assembler.backend
 

basis/cpu/x86/32/32.factor

@@ -173,6 +173,9 @@ M: x86.32 %box-long-long ( n func -- )
         [ (%box-long-long) ] [ f %alien-invoke ] bi*
     ] with-aligned-stack ;
 
+: struct-return@ ( size n -- n )
+    [ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ;
+
 M: x86.32 %box-large-struct ( n size -- )
     ! Compute destination address
     [ swap struct-return@ ] keep

basis/cpu/x86/64/64.factor

@@ -3,9 +3,10 @@
 USING: accessors alien.c-types arrays cpu.x86.assembler
 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
 cpu.x86.allot cpu.architecture kernel kernel.private math
-namespaces sequences compiler.generator compiler.generator.registers
+namespaces make sequences compiler.generator
-compiler.generator.fixup system layouts alien alien.accessors
+compiler.generator.registers compiler.generator.fixup system
-alien.structs slots splitting assocs ;
+layouts alien alien.accessors alien.structs slots splitting
+assocs ;
 IN: cpu.x86.64
 
 M: x86.64 ds-reg R14 ;
@@ -115,6 +116,9 @@ M: x86.64 %box-small-struct ( size -- )
     RDX swap MOV
     "box_small_struct" f %alien-invoke ;
 
+: struct-return@ ( size n -- n )
+    [ ] [ \ stack-frame get swap - ] ?if ;
+
 M: x86.64 %box-large-struct ( n size -- )
     ! Struct size is parameter 2
     RSI over MOV

basis/cpu/x86/architecture/architecture.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays cpu.x86.assembler
 cpu.x86.assembler.private cpu.architecture kernel kernel.private
-math memory namespaces sequences words compiler.generator
+math memory namespaces make sequences words compiler.generator
 compiler.generator.registers compiler.generator.fixup system
 layouts combinators compiler.constants math.order ;
 IN: cpu.x86.architecture
@@ -141,13 +141,6 @@ M: x86 small-enough? ( n -- ? )
 
 : temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
 
-: struct-return@ ( size n -- n )
-    [
-        stack-frame* cell + +
-    ] [
-        \ stack-frame get swap -
-    ] ?if ;
-
 HOOK: %unbox-struct-1 cpu ( -- )
 
 HOOK: %unbox-struct-2 cpu ( -- )

basis/cpu/x86/assembler/assembler-tests.factor

@@ -1,4 +1,4 @@
-USING: cpu.x86.assembler kernel tools.test namespaces ;
+USING: cpu.x86.assembler kernel tools.test namespaces make ;
 IN: cpu.x86.assembler.tests
 
 [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test

basis/cpu/x86/assembler/assembler.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays compiler.generator.fixup io.binary kernel
-combinators kernel.private math namespaces sequences
+combinators kernel.private math namespaces make sequences
 words system layouts math.order accessors
 cpu.x86.assembler.syntax ;
 IN: cpu.x86.assembler

basis/csv/csv.factor

@@ -4,7 +4,8 @@
 ! Simple CSV Parser
 ! Phil Dawes phil@phildawes.net
 
-USING: kernel sequences io namespaces combinators unicode.categories ;
+USING: kernel sequences io namespaces make
+combinators unicode.categories ;
 IN: csv
 
 SYMBOL: delimiter

basis/db/db-docs.factor

@@ -12,11 +12,11 @@ HELP: new-db
 { $description "Creates a new database object from a given class." } ;
 
 HELP: make-db*
-{ $values { "seq" sequence } { "db" object } { "db" object } }
+{ $values { "object" object } { "db" object } { "db" object } }
 { $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ;
 
 HELP: make-db
-{ $values { "seq" sequence } { "class" class } { "db" db } }
+{ $values { "object" object } { "class" class } { "db" db } }
 { $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ;
 
 HELP: db-open

basis/db/postgresql/postgresql.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs alien alien.syntax continuations io
-kernel math math.parser namespaces prettyprint quotations
+kernel math math.parser namespaces make prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
 combinators classes locals words tools.walker

basis/db/queries/queries.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math namespaces sequences random strings
+USING: accessors kernel math namespaces make sequences random
-math.parser math.intervals combinators math.bitwise nmake db
+strings math.parser math.intervals combinators math.bitwise
-db.tuples db.types db.sql classes words shuffle arrays destructors
+nmake db db.tuples db.types db.sql classes words shuffle arrays
-continuations ;
+destructors continuations ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )

basis/db/tuples/tuples-docs.factor

@@ -154,7 +154,7 @@ T{ book
 "Now we've created a book. Let's save it to the database."
 { $code <" USING: db db.sqlite fry io.files ;
 : with-book-tutorial ( quot -- )
-     '[ "book-tutorial.db" temp-file sqlite-db , with-db ] call ;
+     '[ "book-tutorial.db" temp-file sqlite-db _ with-db ] call ;
 
 [
     book recreate-table

basis/db/tuples/tuples-tests.factor

@@ -201,10 +201,10 @@ TUPLE: annotation n paste-id summary author mode contents ;
 ! ] with-db
 
 : test-sqlite ( quot -- )
-    [ ] swap '[ "tuples-test.db" temp-file sqlite-db , with-db ] unit-test ;
+    [ ] swap '[ "tuples-test.db" temp-file sqlite-db _ with-db ] unit-test ;
 
 : test-postgresql ( quot -- )
-    [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db , with-db ] unit-test ;
+    [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db _ with-db ] unit-test ;
 
 : test-repeated-insert
     [ ] [ person ensure-table ] unit-test

basis/debugger/debugger.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: slots arrays definitions generic hashtables summary io
-kernel math namespaces prettyprint prettyprint.config sequences
+kernel math namespaces make prettyprint prettyprint.config
-assocs sequences.private strings io.styles io.files vectors
+sequences assocs sequences.private strings io.styles io.files
-words system splitting math.parser classes.tuple continuations
+vectors words system splitting math.parser classes.tuple
-continuations.private combinators generic.math classes.builtin
+continuations continuations.private combinators generic.math
-classes compiler.units generic.standard vocabs init
+classes.builtin classes compiler.units generic.standard vocabs
-kernel.private io.encodings accessors math.order
+init kernel.private io.encodings accessors math.order
 destructors source-files parser classes.tuple.parser
 effects.parser lexer compiler.errors generic.parser
 strings.parser ;

basis/debugger/threads/threads.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors debugger continuations threads threads.private
-io io.styles prettyprint kernel math.parser namespaces ;
+io io.styles prettyprint kernel math.parser namespaces make ;
 IN: debugger.threads
 
 : error-in-thread. ( thread -- )

basis/delegate/delegate.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors parser generic kernel classes classes.tuple
 words slots assocs sequences arrays vectors definitions
-prettyprint math hashtables sets macros namespaces ;
+prettyprint math hashtables sets macros namespaces make ;
 IN: delegate
 
 : protocol-words ( protocol -- words )

basis/disjoint-sets/disjoint-sets.factor

@@ -64,7 +64,7 @@ M: disjoint-set add-atom
     [ 1 -rot counts>> set-at ]
     2tri ;
 
-: add-atoms ( seq disjoint-set -- ) '[ , add-atom ] each ;
+: add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;
 
 GENERIC: disjoint-set-member? ( a disjoint-set -- ? )
 
@@ -89,7 +89,7 @@ M:: disjoint-set equate ( a b disjoint-set -- )
     ] if ;
 
 : equate-all-with ( seq a disjoint-set -- )
-    '[ , , equate ] each ;
+    '[ _ _ equate ] each ;
 
 : equate-all ( seq disjoint-set -- )
     over empty? [ 2drop ] [
@@ -102,7 +102,7 @@ M: disjoint-set clone
 
 : assoc>disjoint-set ( assoc -- disjoint-set )
     <disjoint-set>
-    [ '[ drop , add-atom ] assoc-each ]
+    [ '[ drop _ add-atom ] assoc-each ]
-    [ '[ , equate ] assoc-each ]
+    [ '[ _ equate ] assoc-each ]
     [ nip ]
     2tri ;

basis/documents/documents.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays io kernel math models namespaces
+USING: accessors arrays io kernel math models namespaces make
 sequences strings splitting combinators unicode.categories
 math.order ;
 IN: documents

basis/fry/fry-docs.factor

@@ -1,15 +1,12 @@
 USING: help.markup help.syntax quotations kernel ;
 IN: fry
 
-HELP: ,
+HELP: _
 { $description "Fry specifier. Inserts a literal value into the fried quotation." } ;
 
 HELP: @
 { $description "Fry specifier. Splices a quotation into the fried quotation." } ;
 
-HELP: _
-{ $description "Fry specifier. Shifts all fry specifiers to the left down by one stack position." } ;
-
 HELP: fry
 { $values { "quot" quotation } { "quot'" quotation } }
 { $description "Outputs a quotation that when called, fries " { $snippet "quot" } " by taking values from the stack and substituting them in." }
@@ -19,7 +16,7 @@ HELP: fry
 
 HELP: '[
 { $syntax "code... ]" }
-{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link , } " and " { $link @ } "." }
+{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link _ } " and " { $link @ } "." }
 { $examples "See " { $link "fry.examples" } "." } ;
 
 ARTICLE: "fry.examples" "Examples of fried quotations"
@@ -27,69 +24,50 @@ ARTICLE: "fry.examples" "Examples of fried quotations"
 $nl
 "If a quotation does not contain any fry specifiers, then " { $link POSTPONE: '[ } " behaves just like " { $link POSTPONE: [ } ":"
 { $code "{ 10 20 30 } '[ . ] each" }
-"Occurrences of " { $link , } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
+"Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
 { $code 
-    "{ 10 20 30 } 5 '[ , + ] map"
+    "{ 10 20 30 } 5 '[ _ + ] map"
     "{ 10 20 30 } 5 [ + ] curry map"
     "{ 10 20 30 } [ 5 + ] map"
 }
-"Occurrences of " { $link , } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"
+"Occurrences of " { $link _ } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"
 { $code 
-    "{ 10 20 30 } 5 '[ 3 , / ] map"
+    "{ 10 20 30 } 5 '[ 3 _ / ] map"
     "{ 10 20 30 } 5 [ 3 ] swap [ / ] curry compose map"
     "{ 10 20 30 } [ 3 5 / ] map"
 }
-"Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet ", call" } ". The following four lines are equivalent:"
+"Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet "_ call" } ". The following four lines are equivalent:"
 { $code 
     "{ 10 20 30 } [ sq ] '[ @ . ] each"
     "{ 10 20 30 } [ sq ] [ call . ] curry each"
     "{ 10 20 30 } [ sq ] [ . ] compose each"
     "{ 10 20 30 } [ sq . ] each"
 }
-"The " { $link , } " and " { $link @ } " specifiers may be freely mixed:"
+"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:"
 { $code
-    "{ 8 13 14 27 } [ even? ] 5 '[ @ dup , ? ] map"
+    "{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"
     "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"
     "{ 8 13 14 27 } [ even? dup 5 ? ] map"
 }
-"Occurrences of " { $link _ } " have the effect of enclosing all code to their left in a quotation passed to " { $link dip } ". The following four lines are equivalent:"
-{ $code 
-    "{ 10 20 30 } 1 '[ , _ / ] map"
-    "{ 10 20 30 } 1 [ [ ] curry dip / ] curry map"
-    "{ 10 20 30 } 1 [ swap / ] curry map"
-    "{ 10 20 30 } [ 1 swap / ] map"
-}
-"For any quotation body " { $snippet "X" } ", the following two are equivalent:"
-{ $code
-    "[ [ X ] dip ]"
-    "'[ X _ ]"
-}
 "Here are some built-in combinators rewritten in terms of fried quotations:"
 { $table
-    { { $link literalize } { $snippet ": literalize '[ , ] ;" } }
+    { { $link literalize } { $snippet ": literalize '[ _ ] ;" } }
-    { { $link slip } { $snippet ": slip '[ @ , ] call ;" } }
+    { { $link slip } { $snippet ": slip '[ @ _ ] call ;" } }
-    { { $link dip } { $snippet ": dip '[ @ _ ] call ;" } }
+    { { $link curry } { $snippet ": curry '[ _ @ ] ;" } }
-    { { $link curry } { $snippet ": curry '[ , @ ] ;" } }
-    { { $link with } { $snippet ": with swapd '[ , _ @ ] ;" } }
     { { $link compose } { $snippet ": compose '[ @ @ ] ;" } }
-    { { $link bi@ } { $snippet ": bi@ tuck '[ , @ , @ ] call ;" } }
+    { { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }
 } ;
 
 ARTICLE: "fry.philosophy" "Fried quotation philosophy"
 "Fried quotations generalize quotation-building words such as " { $link curry } " and " { $link compose } ". They can clean up code with lots of currying and composition, particularly when quotations are nested:"
 { $code
-    "'[ [ , key? ] all? ] filter"
+    "'[ [ _ key? ] all? ] filter"
     "[ [ key? ] curry all? ] curry filter"
 }
 "There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a ``let'' form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:"
 { $code
-    "'[ 3 , + 4 , / ]"
+    "'[ 3 _ + 4 _ / ]"
     "[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]"
-}
-"The " { $link _ } " fry specifier has no direct analogue in " { $vocab-link "locals" } ", however closure conversion together with the " { $link dip } " combinator achieve the same effect:"
-{ $code
-    "'[ , 2 + , * _ / ]"
-    "[let | a [ ] b [ ] | [ [ a 2 + b * ] dip / ] ]"
 } ;
 
 ARTICLE: "fry.limitations" "Fried quotation limitations"
@@ -101,9 +79,8 @@ $nl
 "Fried quotations are denoted with a special parsing word:"
 { $subsection POSTPONE: '[ }
 "Fried quotations contain zero or more " { $emphasis "fry specifiers" } ":"
-{ $subsection , }
-{ $subsection @ }
 { $subsection _ }
+{ $subsection @ }
 "When a fried quotation is being evaluated, values are consumed from the stack and spliced into the quotation from right to left."
 { $subsection "fry.examples" }
 { $subsection "fry.philosophy" }

basis/fry/fry-tests.factor

@@ -2,63 +2,59 @@ IN: fry.tests
 USING: fry tools.test math prettyprint kernel io arrays
 sequences ;
 
-[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
+[ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
 
-[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
+[ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
 
-[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
+[ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
 
-[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
+[ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
 
 [ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
 
 [ [ "a" write "b" print ] ]
-[ "a" "b" '[ , write , print ] ] unit-test
+[ "a" "b" '[ _ write _ print ] ] unit-test
 
 [ [ 1 2 + 3 4 - ] ]
 [ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
 
 [ 1/2 ] [
-    1 '[ , _ / ] 2 swap call
+    1 '[ [ _ ] dip / ] 2 swap call
 ] unit-test
 
 [ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
-    1 '[ , _ _ 3array ]
+    1 '[ [ _ ] 2dip 3array ]
     { "a" "b" "c" } { "A" "B" "C" } rot 2map
 ] unit-test
 
 [ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
-    '[ 1 _ 2array ]
+    '[ [ 1 ] dip 2array ]
     { "a" "b" "c" } swap map
 ] unit-test
 
-[ 1 2 ] [
-    1 2 '[ _ , ] call
-] unit-test
-
 [ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
-    1 2 '[ , _ , 3array ]
+    1 2 '[ [ _ ] dip _ 3array ]
     { "a" "b" "c" } swap map
 ] unit-test
 
-: funny-dip '[ @ _ ] call ; inline
+: funny-dip '[ [ @ ] dip ] call ; inline
 
 [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
 
 [ { 1 2 3 } ] [
-    3 1 '[ , [ , + ] map ] call
+    3 1 '[ _ [ _ + ] map ] call
 ] unit-test
 
 [ { 1 { 2 { 3 } } } ] [
-    1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
+    1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
 ] unit-test
 
-{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
+{ 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
 
 [ { { { 3 } } } ] [
-    3 '[ [ [ , 1array ] call 1array ] call 1array ] call
+    3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
 ] unit-test
 
 [ { { { 3 } } } ] [
-    3 '[ [ [ , 1array ] call 1array ] call 1array ] call
+    3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
 ] unit-test

basis/fry/fry.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences combinators parser splitting math
-quotations arrays namespaces qualified ;
+quotations arrays make qualified words ;
-QUALIFIED: namespaces
 IN: fry
 
-: , ( -- * ) "Only valid inside a fry" throw ;
-: @ ( -- * ) "Only valid inside a fry" throw ;
 : _ ( -- * ) "Only valid inside a fry" throw ;
+: @ ( -- * ) "Only valid inside a fry" throw ;
+
+<PRIVATE
 
 DEFER: (shallow-fry)
 DEFER: shallow-fry
@@ -19,48 +19,33 @@ DEFER: shallow-fry
     ] unless-empty ; inline
 
 : (shallow-fry) ( accum quot -- result )
-    [
+    [ 1quotation ] [
-        1quotation
-    ] [
         unclip {
-            { \ , [ [ curry ] ((shallow-fry)) ] }
+            { \ _ [ [ curry ] ((shallow-fry)) ] }
             { \ @ [ [ compose ] ((shallow-fry)) ] }
-
-            ! to avoid confusion, remove if fry goes core
-            { \ namespaces:, [ [ curry ] ((shallow-fry)) ] }
-
             [ swap >r suffix r> (shallow-fry) ]
         } case
     ] if-empty ;
 
 : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
 
-: deep-fry ( quot -- quot )
+PREDICATE: fry-specifier < word { _ @ } memq? ;
-    { _ } last-split1 dup [
-      shallow-fry [ >r ] rot
-      deep-fry    [ [ dip ] curry r> compose ] 4array concat
-    ] [
-        drop shallow-fry
-    ] if ;
 
-: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
+GENERIC: count-inputs ( quot -- n )
+
+M: callable count-inputs [ count-inputs ] sigma ;
+M: fry-specifier count-inputs drop 1 ;
+M: object count-inputs drop 0 ;
+
+PRIVATE>
 
-: count-inputs ( quot -- n )
-    [
-        {
-            { [ dup callable?      ] [ count-inputs ] }
-            { [ dup fry-specifier? ] [ drop 1       ] }
-                                     [ drop 0       ]
-        } cond
-    ] map sum ;
-    
 : fry ( quot -- quot' )
     [
         [
             dup callable? [
-                [ count-inputs \ , <repetition> % ] [ fry % ] bi
+                [ count-inputs \ _ <repetition> % ] [ fry % ] bi
-            ] [ namespaces:, ] if
+            ] [ , ] if
         ] each
-    ] [ ] make deep-fry ;
+    ] [ ] make shallow-fry ;
 
 : '[ \ ] parse-until fry over push-all ; parsing

basis/furnace/actions/actions.factor

@@ -60,7 +60,7 @@ TUPLE: action rest authorize init display validate submit ;
 
 : handle-get ( action -- response )
     '[
-        , dup display>> [
+        _ dup display>> [
             {
                 [ init>> call ]
                 [ authorize>> call ]
@@ -90,7 +90,7 @@ TUPLE: action rest authorize init display validate submit ;
 
 : handle-post ( action -- response )
     '[
-        , dup submit>> [
+        _ dup submit>> [
             [ validate>> call ]
             [ authorize>> call ]
             [ submit>> call ]
@@ -133,4 +133,4 @@ TUPLE: page-action < action template ;
 
 : <page-action> ( -- page )
     page-action new-action
-        dup '[ , template>> <chloe-content> ] >>display ;
+        dup '[ _ template>> <chloe-content> ] >>display ;

basis/furnace/alloy/alloy.factor

@@ -14,7 +14,7 @@ IN: furnace.alloy
     '[
         <conversations>
         <sessions>
-        , , <db-persistence>
+        _ _ <db-persistence>
         <check-form-submissions>
     ] call ;
 
@@ -26,5 +26,5 @@ IN: furnace.alloy
 
 : start-expiring ( db params -- )
     '[
-        , , [ state-classes [ expire-state ] each ] with-db
+        _ _ [ state-classes [ expire-state ] each ] with-db
     ] 5 minutes every drop ;

basis/furnace/auth/auth.factor

@@ -125,7 +125,7 @@ TUPLE: secure-realm-only < filter-responder ;
 C: <secure-realm-only> secure-realm-only
 
 M: secure-realm-only call-responder*
-    '[ , , call-next-method ] if-secure-realm ;
+    '[ _ _ call-next-method ] if-secure-realm ;
 
 TUPLE: protected < filter-responder description capabilities ;
 

basis/furnace/auth/basic/basic.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel splitting base64 namespaces strings
+USING: accessors kernel splitting base64 namespaces make strings
 http http.server.responses furnace.auth ;
 IN: furnace.auth.basic
 

basis/furnace/auth/features/recover-password/recover-password.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces accessors kernel assocs arrays io.sockets threads
+USING: namespaces make accessors kernel assocs arrays io.sockets
-fry urls smtp validators html.forms present
+threads fry urls smtp validators html.forms present
 http http.server.responses http.server.redirection
 http.server.dispatchers
 furnace furnace.actions furnace.auth furnace.auth.providers
@@ -43,7 +43,7 @@ SYMBOL: lost-password-from
         ] "" make >>body ;
 
 : send-password-email ( user -- )
-    '[ , password-email send-email ]
+    '[ _ password-email send-email ]
     "E-mail send thread" spawn drop ;
 
 : <recover-action-1> ( -- action )

basis/furnace/chloe-tags/chloe-tags.factor

@@ -56,7 +56,7 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
 
 : compile-link-attrs ( tag -- )
     #! Side-effects current namespace.
-    attrs>> '[ [ , _ link-attr ] each-responder ] [code] ;
+    attrs>> '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
 
 : a-start-tag ( tag -- )
     [ compile-link-attrs ] [ compile-a-url ] bi
@@ -72,7 +72,7 @@ CHLOE: a
 
 : compile-hidden-form-fields ( for -- )
     '[
-        , [ "," split [ hidden render ] each ] when*
+        _ [ "," split [ hidden render ] each ] when*
         nested-forms get " " join f like nested-forms-key hidden-form-field
         [ modify-form ] each-responder
     ] [code] ;

basis/furnace/conversations/conversations.factor

@@ -109,8 +109,8 @@ M: conversations call-responder*
 : restore-conversation ( seq -- )
     conversation get dup [
         namespace>>
-        [ '[ , key? ] filter ]
+        [ '[ _ key? ] filter ]
-        [ '[ [ , at ] keep set ] each ]
+        [ '[ [ _ at ] keep set ] each ]
         bi
     ] [ 2drop ] if ;
 

basis/furnace/furnace.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs sequences kernel classes splitting
+USING: namespaces make assocs sequences kernel classes splitting
 vocabs.loader accessors strings combinators arrays
 continuations present fry
 urls html.elements

basis/furnace/redirection/redirection.factor

@@ -42,4 +42,4 @@ C: <secure-only> secure-only
     } cond ; inline
 
 M: secure-only call-responder*
-    '[ , , call-next-method ] if-secure ;
+    '[ _ _ call-next-method ] if-secure ;

basis/furnace/sessions/sessions-tests.factor

@@ -1,10 +1,9 @@
 IN: furnace.sessions.tests
-USING: tools.test http furnace.sessions
+USING: tools.test http furnace.sessions furnace.actions
-furnace.actions http.server http.server.responses
+http.server http.server.responses math namespaces make kernel
-math namespaces kernel accessors io.sockets io.servers.connection
+accessors io.sockets io.servers.connection prettyprint
-prettyprint io.streams.string io.files splitting destructors
+io.streams.string io.files splitting destructors sequences db
-sequences db db.tuples db.sqlite continuations urls math.parser
+db.tuples db.sqlite continuations urls math.parser furnace ;
-furnace ;
 
 : with-session
     [

basis/furnace/syndication/syndication.factor

@@ -44,7 +44,7 @@ TUPLE: feed-action < action title url entries ;
     feed-action new-action
         dup '[
             feed new
-                ,
+                _
                 [ title>> call >>title ]
                 [ url>> call adjust-url relative-to-request >>url ]
                 [ entries>> call process-entries >>entries ]

basis/generalizations/generalizations.factor

@@ -6,24 +6,24 @@ math.ranges combinators macros quotations fry arrays ;
 IN: generalizations
 
 MACRO: nsequence ( n seq -- quot )
-    [ drop <reversed> ] [ '[ , , new-sequence ] ] 2bi
+    [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
-    [ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ;
+    [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce ;
 
 MACRO: narray ( n -- quot )
-    '[ , { } nsequence ] ;
+    '[ _ { } nsequence ] ;
 
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
-        [ [ '[ , _ nth-unsafe ] ] map ]
+        [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
-        [ 1- '[ , _ bounds-check 2drop ] ]
+        [ 1- '[ [ _ ] dip bounds-check 2drop ] ]
-        bi prefix '[ , cleave ]
+        bi prefix '[ _ cleave ]
     ] if ;
 
 MACRO: npick ( n -- )
     1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
 
 MACRO: ndup ( n -- )
-    dup '[ , npick ] n*quot ;
+    dup '[ _ npick ] n*quot ;
 
 MACRO: nrot ( n -- )
     1- dup saver swap [ r> swap ] n*quot append ;
@@ -41,7 +41,7 @@ MACRO: ntuck ( n -- )
     2 + [ dupd -nrot ] curry ;
 
 MACRO: nrev ( n -- quot )
-    1 [a,b] [ ] [ '[ @ , -nrot ] ] reduce ;
+    1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ;
 
 MACRO: ndip ( quot n -- )
     dup saver -rot restorer 3append ;
@@ -51,7 +51,7 @@ MACRO: nslip ( n -- )
 
 MACRO: nkeep ( n -- )
     [ ] [ 1+ ] [ ] tri
-    '[ [ , ndup ] dip , -nrot , nslip ] ;
+    '[ [ _ ndup ] dip _ -nrot _ nslip ] ;
 
 MACRO: ncurry ( n -- )
     [ curry ] n*quot ;
@@ -61,5 +61,5 @@ MACRO: nwith ( n -- )
 
 MACRO: napply ( n -- )
     2 [a,b]
-    [ [ 1- ] keep '[ , ntuck , nslip ] ]
+    [ [ 1- ] keep '[ _ ntuck _ nslip ] ]
     map concat >quotation [ call ] append ;

basis/help/handbook/handbook.factor

@@ -108,6 +108,7 @@ USE: io.buffers
 ARTICLE: "collections" "Collections" 
 { $heading "Sequences" }
 { $subsection "sequences" }
+{ $subsection "namespaces-make" }
 "Fixed-length sequences:"
 { $subsection "arrays" }
 { $subsection "quotations" }

basis/help/help.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays io io.styles kernel namespaces parser
+USING: accessors arrays io io.styles kernel namespaces make
-prettyprint sequences words assocs definitions generic
+parser prettyprint sequences words assocs definitions generic
 quotations effects slots continuations classes.tuple debugger
 combinators vocabs help.stylesheet help.topics help.crossref
 help.markup sorting classes vocabs.loader ;

basis/help/lint/lint.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors sequences parser kernel help help.markup
-help.topics words strings classes tools.vocabs namespaces io
+help.topics words strings classes tools.vocabs namespaces make
-io.streams.string prettyprint definitions arrays vectors
+io io.streams.string prettyprint definitions arrays vectors
 combinators combinators.short-circuit splitting debugger
 hashtables sorting effects vocabs vocabs.loader assocs editors
 continuations classes.predicate macros math sets eval ;
@@ -39,7 +39,7 @@ IN: help.lint
         $predicate
         $class-description
         $error-description
-    } swap '[ , elements empty? not ] contains? ;
+    } swap '[ _ elements empty? not ] contains? ;
 
 : check-values ( word element -- )
     {
@@ -110,7 +110,7 @@ M: help-error error.
     H{ } clone [
         '[
             dup >link where dup
-            [ first , at , push-at ] [ 2drop ] if
+            [ first _ at _ push-at ] [ 2drop ] if
         ] each
     ] keep ;
 

basis/help/markup/markup.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions generic io kernel assocs
-hashtables namespaces parser prettyprint sequences strings
+hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots
 vocabs help.stylesheet help.topics vocabs.loader alias ;
 IN: help.markup

basis/help/topics/topics.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.x
 USING: accessors arrays definitions generic assocs
-io kernel namespaces prettyprint prettyprint.sections
+io kernel namespaces make prettyprint prettyprint.sections
 sequences words summary classes strings vocabs ;
 IN: help.topics
 

basis/hints/hints.factor

@@ -21,7 +21,7 @@ IN: hints
 : specializer-cases ( quot word -- default alist )
     dup [ array? ] all? [ 1array ] unless [
         [ make-specializer ] keep
-        '[ , declare ] pick append
+        '[ _ declare ] pick append
     ] { } map>assoc ;
 
 : method-declaration ( method -- quot )
@@ -30,7 +30,7 @@ IN: hints
     bi prefix ;
 
 : specialize-method ( quot method -- quot' )
-    method-declaration '[ , declare ] prepend ;
+    method-declaration '[ _ declare ] prepend ;
 
 : specialize-quot ( quot specializer -- quot' )
     specializer-cases alist>quot ;
@@ -91,7 +91,7 @@ IN: hints
 
 \ >string { sbuf } "specializer" set-word-prop
 
-\ >array { { string } { vector } } "specializer" set-word-prop
+\ >array { { vector } } "specializer" set-word-prop
 
 \ >vector { { array } { vector } } "specializer" set-word-prop
 
@@ -101,7 +101,7 @@ IN: hints
 
 \ memq? { array } "specializer" set-word-prop
 
-\ member? { fixnum string } "specializer" set-word-prop
+\ member? { array } "specializer" set-word-prop
 
 \ assoc-stack { vector } "specializer" set-word-prop
 

basis/html/components/components.factor

@@ -88,7 +88,7 @@ TUPLE: choice size multiple choices ;
     </option> ;
 
 : render-options ( options selected -- )
-    '[ dup , member? render-option ] each ;
+    '[ dup _ member? render-option ] each ;
 
 M: choice render*
     <select

basis/html/elements/elements.factor

@@ -70,7 +70,7 @@ SYMBOL: html
 : def-for-html-word-<foo> ( name -- )
     #! Return the name and code for the <foo> patterned
     #! word.
-    dup <foo> swap '[ , <foo> write-html ]
+    dup <foo> swap '[ _ <foo> write-html ]
     (( -- )) html-word ;
 
 : <foo ( str -- <str ) "<" prepend ;
@@ -78,7 +78,7 @@ SYMBOL: html
 : def-for-html-word-<foo ( name -- )
     #! Return the name and code for the <foo patterned
     #! word.
-    <foo dup '[ , write-html ]
+    <foo dup '[ _ write-html ]
     (( -- )) html-word ;
 
 : foo> ( str -- foo> ) ">" append ;
@@ -93,14 +93,14 @@ SYMBOL: html
 : def-for-html-word-</foo> ( name -- )
     #! Return the name and code for the </foo> patterned
     #! word.
-    </foo> dup '[ , write-html ] (( -- )) html-word ;
+    </foo> dup '[ _ write-html ] (( -- )) html-word ;
 
 : <foo/> ( str -- <str/> ) "<" swap "/>" 3append ;
 
 : def-for-html-word-<foo/> ( name -- )
     #! Return the name and code for the <foo/> patterned
     #! word.
-    dup <foo/> swap '[ , <foo/> write-html ]
+    dup <foo/> swap '[ _ <foo/> write-html ]
     (( -- )) html-word ;
 
 : foo/> ( str -- str/> ) "/>" append ;
@@ -134,7 +134,7 @@ SYMBOL: html
 
 : define-attribute-word ( name -- )
     dup "=" prepend swap
-    '[ , write-attr ] (( string -- )) html-word ;
+    '[ _ write-attr ] (( string -- )) html-word ;
 
 ! Define some closed HTML tags
 [

basis/html/forms/forms.factor

@@ -63,7 +63,7 @@ SYMBOL: nested-forms
 
 : with-form ( name quot -- )
     '[
-        ,
+        _
         [ nested-forms [ swap prefix ] change ]
         [ value form set ]
         bi
@@ -103,4 +103,4 @@ C: <validation-error> validation-error
     swap set-value ;
 
 : validate-values ( assoc validators -- assoc' )
-    swap '[ dup , at _ validate-value ] assoc-each ;
+    swap '[ [ dup _ at ] dip validate-value ] assoc-each ;

basis/html/streams/streams.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-
+USING: combinators generic assocs help http io io.styles
-USING: combinators generic assocs help http io io.styles io.files
+io.files continuations io.streams.string kernel math math.order
-       continuations io.streams.string kernel math math.order math.parser
+math.parser namespaces make quotations assocs sequences strings
-       namespaces quotations assocs sequences strings words html.elements
+words html.elements xml.entities sbufs continuations destructors
-       xml.entities sbufs continuations destructors accessors arrays ;
+accessors arrays ;
-
 IN: html.streams
 
 GENERIC: browser-link-href ( presented -- href )

basis/html/templates/chloe/chloe.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences combinators kernel fry
-namespaces classes.tuple assocs splitting words arrays memoize
+namespaces make classes.tuple assocs splitting words arrays
-io io.files io.encodings.utf8 io.streams.string unicode.case
+memoize io io.files io.encodings.utf8 io.streams.string
-mirrors math urls present multiline quotations xml xml.data
+unicode.case mirrors math urls present multiline quotations xml
+xml.data
 html.forms
 html.elements
 html.components

basis/html/templates/chloe/compiler/compiler.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs namespaces kernel sequences accessors combinators
+USING: assocs namespaces make kernel sequences accessors
-strings splitting io io.streams.string present xml.writer
+combinators strings splitting io io.streams.string present
-xml.data xml.entities html.forms html.templates.chloe.syntax ;
+xml.writer xml.data xml.entities html.forms
+html.templates.chloe.syntax ;
 IN: html.templates.chloe.compiler
 
 : chloe-attrs-only ( assoc -- assoc' )

basis/html/templates/chloe/components/components.factor

@@ -14,13 +14,13 @@ IN: html.templates.chloe.components
 
 : CHLOE-SINGLETON:
     scan-word
-    [ name>> ] [ '[ , singleton-component-tag ] ] bi
+    [ name>> ] [ '[ _ singleton-component-tag ] ] bi
     define-chloe-tag ;
     parsing
 
 : compile-component-attrs ( tag class -- )
     [ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip
-    [ all-slots swap '[ name>> , at compile-attr ] each ]
+    [ all-slots swap '[ name>> _ at compile-attr ] each ]
     [ [ boa ] [code-with] ]
     bi ;
 
@@ -30,6 +30,6 @@ IN: html.templates.chloe.components
 
 : CHLOE-TUPLE:
     scan-word
-    [ name>> ] [ '[ , tuple-component-tag ] ] bi
+    [ name>> ] [ '[ _ tuple-component-tag ] ] bi
     define-chloe-tag ;
     parsing