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

basis/compiler/tree/propagation/info/info.factor

@@ -12,8 +12,6 @@ IN: compiler.tree.propagation.info
 
 : null-class? ( class -- ? ) null class<= ;
 
-SYMBOL: +interval+
-
 GENERIC: eql? ( obj1 obj2 -- ? )
 M: object eql? eq? ;
 M: fixnum eql? eq? ;
@@ -40,7 +38,7 @@ slots ;
 
 : class-interval ( class -- interval )
     dup real class<=
-    [ +interval+ word-prop [-inf,inf] or ] [ drop f ] if ;
+    [ "interval" word-prop [-inf,inf] or ] [ drop f ] if ;
 
 : interval>literal ( class interval -- literal literal? )
     #! If interval has zero length and the class is sufficiently
@@ -84,7 +82,7 @@ slots ;
     init-value-info ; foldable
 
 : <class-info> ( class -- info )
-    dup word? [ dup +interval+ word-prop ] [ f ] if [-inf,inf] or
+    dup word? [ dup "interval" word-prop ] [ f ] if [-inf,inf] or
     <class/interval-info> ; foldable
 
 : <interval-info> ( interval -- info )

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

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel arrays sequences math math.order
-math.partial-dispatch generic generic.standard classes.algebra
-classes.union sets quotations assocs combinators words
-namespaces
+math.partial-dispatch generic generic.standard generic.math
+classes.algebra classes.union sets quotations assocs combinators
+words namespaces
 compiler.tree
 compiler.tree.builder
 compiler.tree.normalization
@@ -145,3 +145,13 @@ SYMBOL: history
 
 : always-inline-word? ( word -- ? )
     { curry compose } memq? ;
+
+: do-inlining ( #call word -- ? )
+    {
+        { [ dup always-inline-word? ] [ inline-word ] }
+        { [ dup standard-generic? ] [ inline-standard-method ] }
+        { [ dup math-generic? ] [ inline-math-method ] }
+        { [ dup math-partial? ] [ inline-math-partial ] }
+        { [ dup method-body? ] [ inline-method-body ] }
+        [ 2drop f ]
+    } cond ;

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

@@ -17,11 +17,11 @@ IN: compiler.tree.propagation.known-words
 
 \ fixnum
 most-negative-fixnum most-positive-fixnum [a,b]
-+interval+ set-word-prop
+"interval" set-word-prop
 
 \ array-capacity
 0 max-array-capacity [a,b]
-+interval+ set-word-prop
+"interval" set-word-prop
 
 { + - * / }
 [ { number number } "input-classes" set-word-prop ] each
@@ -66,17 +66,17 @@ most-negative-fixnum most-positive-fixnum [a,b]
     over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline
 
 { bitnot fixnum-bitnot bignum-bitnot } [
-    [ [ interval-bitnot ] ?change-interval ] +outputs+ set-word-prop
+    [ [ interval-bitnot ] ?change-interval ] "outputs" set-word-prop
 ] each
 
-\ abs [ [ interval-abs ] ?change-interval ] +outputs+ set-word-prop
+\ abs [ [ interval-abs ] ?change-interval ] "outputs" set-word-prop
 
 : math-closure ( class -- newclass )
     { fixnum bignum integer rational float real number object }
     [ class<= ] with find nip ;
 
 : fits? ( interval class -- ? )
-    +interval+ word-prop interval-subset? ;
+    "interval" word-prop interval-subset? ;
 
 : binary-op-class ( info1 info2 -- newclass )
     [ class>> ] bi@
@@ -120,7 +120,7 @@ most-negative-fixnum most-positive-fixnum [a,b]
         [ binary-op-class ] [ , binary-op-interval ] 2bi
         @
         <class/interval-info>
-    ] +outputs+ set-word-prop ;
+    ] "outputs" set-word-prop ;
 
 \ + [ [ interval+ ] [ may-overflow number-valued ] binary-op ] each-derived-op
 \ + [ [ interval+ ] [ number-valued ] binary-op ] each-fast-derived-op
@@ -158,7 +158,7 @@ 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
@@ -178,13 +178,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 )
@@ -196,7 +196,7 @@ generic-comparison-ops [
 { number= bignum= float= } [
     [
         info-intervals-intersect? maybe-or-never
-    ] +outputs+ set-word-prop
+    ] "outputs" set-word-prop
 ] each
 
 : info-classes-intersect? ( info1 info2 -- ? )
@@ -206,13 +206,13 @@ generic-comparison-ops [
     over value-info literal>> fixnum? [
         [ value-info literal>> is-equal-to ] dip t-->
     ] [ 3drop f ] if
-] +constraints+ set-word-prop
+] "constraints" set-word-prop
 
 \ eq? [
     [ info-intervals-intersect? ]
     [ info-classes-intersect? ]
     2bi or maybe-or-never
-] +outputs+ set-word-prop
+] "outputs" set-word-prop
 
 {
     { >fixnum fixnum }
@@ -226,7 +226,7 @@ generic-comparison-ops [
             interval-intersect
         ] 2bi
         <class/interval-info>
-    ] +outputs+ set-word-prop
+    ] "outputs" set-word-prop
 ] assoc-each
 
 {
@@ -250,36 +250,36 @@ generic-comparison-ops [
         }
     } cond
     [ fixnum fits? fixnum integer ? ] keep <class/interval-info>
-    [ 2nip ] curry +outputs+ set-word-prop
+    [ 2nip ] curry "outputs" set-word-prop
 ] each
 
 { <tuple> <tuple-boa> } [
     [
         literal>> dup tuple-layout? [ class>> ] [ drop tuple ] if <class-info>
         [ clear ] dip
-    ] +outputs+ set-word-prop
+    ] "outputs" set-word-prop
 ] each
 
 \ new [
     literal>> dup tuple-class? [ drop tuple ] unless <class-info>
-] +outputs+ set-word-prop
+] "outputs" set-word-prop
 
 ! the output of clone has the same type as the input
 { clone (clone) } [
     [ clone f >>literal f >>literal? ]
-    +outputs+ set-word-prop
+    "outputs" set-word-prop
 ] each
 
 \ slot [
     dup literal?>>
     [ literal>> swap value-info-slot ] [ 2drop object-info ] if
-] +outputs+ set-word-prop
+] "outputs" set-word-prop
 
 \ instance? [
     [ value-info ] dip over literal>> class? [
         [ literal>> ] dip predicate-constraints
     ] [ 3drop f ] if
-] +constraints+ set-word-prop
+] "constraints" set-word-prop
 
 \ instance? [
     ! We need to force the caller word to recompile when the class
@@ -292,4 +292,4 @@ generic-comparison-ops [
         [ predicate-output-infos ]
         bi
     ] [ 2drop object-info ] if
-] +outputs+ set-word-prop
+] "outputs" set-word-prop

basis/compiler/tree/propagation/nodes/nodes.factor

@@ -6,9 +6,6 @@ compiler.tree.propagation.copy
 compiler.tree.propagation.info ;
 IN: compiler.tree.propagation.nodes
 
-SYMBOL: +constraints+
-SYMBOL: +outputs+
-
 GENERIC: propagate-before ( node -- )
 
 GENERIC: propagate-after ( node -- )

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

@@ -3,8 +3,7 @@
 USING: fry accessors kernel sequences sequences.private assocs words
 namespaces classes.algebra combinators classes classes.tuple
 classes.tuple.private continuations arrays
-math math.partial-dispatch math.private slots generic definitions
-generic.standard generic.math
+math math.private slots generic definitions
 stack-checker.state
 compiler.tree
 compiler.tree.propagation.info
@@ -52,7 +51,7 @@ M: #declare propagate-before
     with-datastack first assume ;
 
 : compute-constraints ( #call word -- )
-    dup +constraints+ word-prop [ nip custom-constraints ] [
+    dup "constraints" word-prop [ nip custom-constraints ] [
         dup predicate? [
             [ [ in-d>> first ] [ out-d>> first ] bi ]
             [ "predicating" word-prop ] bi*
@@ -61,19 +60,22 @@ M: #declare propagate-before
     ] if* ;
 
 : call-outputs-quot ( #call word -- infos )
-    [ in-d>> [ value-info ] map ] [ +outputs+ word-prop ] bi*
+    [ in-d>> [ value-info ] map ] [ "outputs" word-prop ] bi*
     with-datastack ;
 
 : foldable-call? ( #call word -- ? )
     "foldable" word-prop
     [ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ;
 
-: fold-call ( #call word -- infos )
+: (fold-call) ( #call word -- info )
     [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ , execute ] ] bi*
     '[ , , with-datastack [ <literal-info> ] map nip ]
     [ drop [ object-info ] replicate ]
     recover ;
 
+: fold-call ( #call word -- )
+    [ (fold-call) ] [ drop out-d>> ] 2bi set-value-infos ;
+
 : predicate-output-infos ( info class -- info )
     [ class>> ] dip {
         { [ 2dup class<= ] [ t <literal-info> ] }
@@ -95,30 +97,23 @@ M: #declare propagate-before
 
 : output-value-infos ( #call word -- infos )
     {
-        { [ 2dup foldable-call? ] [ fold-call ] }
         { [ dup tuple-constructor? ] [ propagate-tuple-constructor ] }
         { [ dup sequence-constructor? ] [ propagate-sequence-constructor ] }
         { [ dup predicate? ] [ propagate-predicate ] }
-        { [ dup +outputs+ word-prop ] [ call-outputs-quot ] }
+        { [ dup "outputs" word-prop ] [ call-outputs-quot ] }
         [ default-output-value-infos ]
     } cond ;
 
-: do-inlining ( #call word -- ? )
-    {
-        { [ dup always-inline-word? ] [ inline-word ] }
-        { [ dup standard-generic? ] [ inline-standard-method ] }
-        { [ dup math-generic? ] [ inline-math-method ] }
-        { [ dup math-partial? ] [ inline-math-partial ] }
-        { [ dup method-body? ] [ inline-method-body ] }
-        [ 2drop f ]
-    } cond ;
-
 M: #call propagate-before
-    dup word>> 2dup do-inlining [ 2drop ] [
-        [ [ output-value-infos ] [ drop out-d>> ] 2bi set-value-infos ]
-        [ compute-constraints ]
-        2bi
-    ] if ;
+    dup word>> {
+        { [ 2dup foldable-call? ] [ fold-call ] }
+        { [ 2dup do-inlining ] [ 2drop ] }
+        [
+            [ [ output-value-infos ] [ drop out-d>> ] 2bi set-value-infos ]
+            [ compute-constraints ]
+            2bi
+        ]
+    } cond ;
 
 M: #call annotate-node
     dup [ in-d>> ] [ out-d>> ] bi append (annotate-node) ;

basis/help/topics/topics-tests.factor

@@ -1,6 +1,6 @@
-USING: definitions help help.topics help.crossref help.markup
-help.syntax kernel sequences tools.test words parser namespaces
-assocs source-files eval ;
+USING: accessors definitions help help.topics help.crossref
+help.markup help.syntax kernel sequences tools.test words parser
+namespaces assocs source-files eval ;
 IN: help.topics.tests
 
 \ article-name must-infer

basis/macros/expander/expander.factor

@@ -32,8 +32,8 @@ M: wrapper expand-macros* wrapped>> literal ;
     stack get pop >quotation end (expand-macros) ;
 
 : expand-macro? ( word -- quot ? )
-    dup [ "macro" word-prop ] [ +transform-quot+ word-prop ] bi or dup [
-        swap [ stack-effect in>> length ] [ +transform-n+ word-prop ] bi or
+    dup [ "macro" word-prop ] [ "transform-quot" word-prop ] bi or dup [
+        swap [ stack-effect in>> length ] [ "transform-n" word-prop ] bi or
         stack get length <=
     ] [ 2drop f f ] if ;
 

basis/stack-checker/known-words/known-words.factor

@@ -173,15 +173,13 @@ do-primitive alien-invoke alien-indirect alien-callback
 { call execute dispatch load-locals get-local drop-locals }
 [ t "no-compile" set-word-prop ] each
 
-SYMBOL: +primitive+
-
 : non-inline-word ( word -- )
     dup called-dependency depends-on
     {
         { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
         { [ dup "special" word-prop ] [ infer-special ] }
-        { [ dup +primitive+ word-prop ] [ infer-primitive ] }
-        { [ dup +transform-quot+ word-prop ] [ apply-transform ] }
+        { [ dup "primitive" word-prop ] [ infer-primitive ] }
+        { [ dup "transform-quot" word-prop ] [ apply-transform ] }
         { [ dup "macro" word-prop ] [ apply-macro ] }
         { [ dup "cannot-infer" word-prop ] [ cannot-infer-effect ] }
         { [ dup "inferred-effect" word-prop ] [ cached-infer ] }
@@ -190,7 +188,7 @@ SYMBOL: +primitive+
     } cond ;
 
 : define-primitive ( word inputs outputs -- )
-    [ 2drop t +primitive+ set-word-prop ]
+    [ 2drop t "primitive" set-word-prop ]
     [ drop "input-classes" set-word-prop ]
     [ nip "default-output-classes" set-word-prop ]
     3tri ;
@@ -600,8 +598,6 @@ SYMBOL: +primitive+
 
 \ (set-os-envs) { array } { } define-primitive
 
-\ do-primitive [ \ do-primitive cannot-infer-effect ] "infer" set-word-prop
-
 \ dll-valid? { object } { object } define-primitive
 
 \ modify-code-heap { array object } { } define-primitive

basis/stack-checker/transforms/transforms.factor

@@ -8,9 +8,6 @@ stack-checker.backend stack-checker.state stack-checker.visitor
 stack-checker.errors ;
 IN: stack-checker.transforms
 
-SYMBOL: +transform-quot+
-SYMBOL: +transform-n+
-
 : give-up-transform ( word -- )
     dup recursive-label
     [ call-recursive-word ]
@@ -48,8 +45,8 @@ SYMBOL: +transform-n+
 : apply-transform ( word -- )
     [ inlined-dependency depends-on ] [
         [ ]
-        [ +transform-quot+ word-prop ]
-        [ +transform-n+ word-prop ]
+        [ "transform-quot" word-prop ]
+        [ "transform-n" word-prop ]
         tri
         (apply-transform)
     ] bi ;
@@ -64,8 +61,8 @@ SYMBOL: +transform-n+
     ] bi ;
 
 : define-transform ( word quot n -- )
-    [ drop +transform-quot+ set-word-prop ]
-    [ nip +transform-n+ set-word-prop ]
+    [ drop "transform-quot" set-word-prop ]
+    [ nip "transform-n" set-word-prop ]
     3bi ;
 
 ! Combinators

basis/tools/deploy/shaker/shaker.factor

@@ -85,8 +85,11 @@ IN: tools.deploy.shaker
     [
         strip-dictionary? [
             {
+                "cannot-infer"
                 "coercer"
+                "combination"
                 "compiled-effect"
+                "compiled-generic-uses"
                 "compiled-uses"
                 "constraints"
                 "declared-effect"
@@ -94,38 +97,52 @@ IN: tools.deploy.shaker
                 "default-method"
                 "default-output-classes"
                 "derived-from"
-                "identities"
+                "engines"
                 "if-intrinsics"
                 "infer"
                 "inferred-effect"
+                "inline"
+                "inlined-block"
                 "input-classes"
                 "interval"
                 "intrinsics"
+                "lambda"
                 "loc"
+                "local-reader"
+                "local-reader?"
+                "local-writer"
+                "local-writer?"
+                "local?"
+                "macro"
                 "members"
-                "methods"
+                "memo-quot"
                 "method-class"
                 "method-generic"
-                "combination"
-                "cannot-infer"
+                "methods"
                 "no-compile"
                 "optimizer-hooks"
-                "output-classes"
+                "outputs"
                 "participants"
                 "predicate"
                 "predicate-definition"
                 "predicating"
-                "tuple-dispatch-generic"
-                "slots"
+                "reader"
+                "reading"
+                "recursive"
+                "shuffle"
                 "slot-names"
+                "slots"
+                "special"
                 "specializer"
                 "step-into"
                 "step-into?"
                 "superclass"
-                "reading"
-                "writing"
+                "transform-n"
+                "transform-quot"
+                "tuple-dispatch-generic"
                 "type"
-                "engines"
+                "writer"
+                "writing"
             } %
         ] when
         
@@ -211,6 +228,7 @@ IN: tools.deploy.shaker
                 classes:update-map
                 command-line:main-vocab-hook
                 compiled-crossref
+                compiled-generic-crossref
                 compiler.units:recompile-hook
                 compiler.units:update-tuples-hook
                 definitions:crossref

basis/tools/deploy/test/1/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "tools.deploy.test.1" }
-    { deploy-threads? t }
-    { deploy-compiler? t }
-    { deploy-math? t }
     { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.1" }
     { deploy-io 2 }
-    { deploy-reflection 1 }
-    { deploy-ui? f }
+    { deploy-random? f }
+    { deploy-math? t }
+    { deploy-compiler? t }
+    { deploy-reflection 2 }
     { "stop-after-last-window?" t }
+    { deploy-threads? t }
+    { deploy-ui? f }
     { deploy-word-props? f }
+    { deploy-word-defs? f }
 }

basis/tools/deploy/test/2/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-math? t }
-    { deploy-compiler? t }
-    { deploy-reflection 2 }
+    { deploy-io 2 }
     { deploy-ui? f }
-    { deploy-word-props? f }
     { deploy-threads? t }
     { deploy-c-types? f }
-    { deploy-random? f }
-    { "stop-after-last-window?" t }
     { deploy-name "tools.deploy.test.2" }
-    { deploy-io 2 }
+    { deploy-compiler? t }
+    { deploy-word-props? f }
+    { deploy-reflection 2 }
     { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/deploy/test/3/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "tools.deploy.test.3" }
-    { deploy-threads? t }
-    { deploy-compiler? t }
-    { deploy-math? t }
-    { deploy-c-types? f }
     { deploy-io 3 }
-    { deploy-reflection 1 }
     { deploy-ui? f }
-    { "stop-after-last-window?" t }
+    { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.3" }
+    { deploy-compiler? t }
     { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/deploy/test/4/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-math? t }
-    { deploy-reflection 1 }
     { deploy-io 2 }
-    { deploy-c-types? f }
-    { deploy-random? f }
     { deploy-ui? f }
-    { deploy-name "tools.deploy.test.4" }
-    { deploy-word-defs? f }
-    { "stop-after-last-window?" t }
     { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.4" }
     { deploy-compiler? t }
     { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/deploy/test/5/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-math? t }
-    { deploy-reflection 1 }
     { deploy-io 3 }
-    { deploy-c-types? f }
-    { deploy-random? f }
     { deploy-ui? f }
-    { deploy-name "tools.deploy.test.5" }
-    { deploy-word-defs? f }
-    { "stop-after-last-window?" t }
     { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.5" }
     { deploy-compiler? t }
     { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/ui/gadgets/handler/handler.factor

@@ -8,4 +8,4 @@ TUPLE: handler < wrapper table ;
 : <handler> ( child -- handler ) handler new-wrapper ;
 
 M: handler handle-gesture ( gesture gadget -- ? )
-   over table>> at dup [ call f ] [ 2drop t ] if ;
+   tuck table>> at dup [ call f ] [ 2drop t ] if ;

extra/obj/view/view.factor

@@ -40,7 +40,13 @@ PREDICATE: obj-list < word \ objects = ;
 
 M: obj-list article-title ( objects -- title ) drop "Objects" ;
 
+! M: obj-list article-content ( objects -- title )
+!    execute
+!    [ [ type -> ] [ ] bi 2array ] map
+!    { $tab , } bake ;
+
 M: obj-list article-content ( objects -- title )
-   execute
+   drop
+   objects
    [ [ type -> ] [ ] bi 2array ] map
    { $tab , } bake ;