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

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

@@ -52,17 +52,17 @@ HELP: 3||
      { "quot" quotation } }
 { $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
 
-HELP: n&&-rewrite
+HELP: n&&
 { $values
      { "quots" "a sequence of quotations" } { "N" integer }
      { "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each AND quotation." } ;
+{ $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each AND quotation." } ;
 
-HELP: n||-rewrite
+HELP: n||
 { $values
-     { "quots" "a sequence of quotations" } { "N" integer }
+     { "quots" "a sequence of quotations" } { "n" integer }
      { "quot" quotation } }
-{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ;
+{ $description "A macro that reqrites the code to pass " { $snippet "n" } " parameters from the stack to each OR quotation." } ;
 
 ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
 "The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
@@ -77,8 +77,8 @@ ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
 { $subsection 2|| }
 { $subsection 3|| }
 "Generalized combinators:"
-{ $subsection n&&-rewrite }
+{ $subsection n&& }
-{ $subsection n||-rewrite }
+{ $subsection n|| }
 ;
 
 ABOUT: "combinators.short-circuit"

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

@@ -1,35 +1,26 @@
-
 USING: kernel combinators quotations arrays sequences assocs
-       locals generalizations macros fry ;
+locals generalizations macros fry ;
-
 IN: combinators.short-circuit
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+MACRO:: n&& ( quots n -- quot )
+    [ f ]
+    quots [| q | { [ drop n ndup q call dup not ] [ drop n ndrop f ] } ] map
+    [ n nnip ] suffix 1array
+    [ cond ] 3append ;
 
-:: n&&-rewrite ( quots N -- quot )
+MACRO: 0&& ( quots -- quot ) '[ _ 0 n&& ] ;
-   quots
+MACRO: 1&& ( quots -- quot ) '[ _ 1 n&& ] ;
-     [ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
+MACRO: 2&& ( quots -- quot ) '[ _ 2 n&& ] ;
-   map
+MACRO: 3&& ( quots -- quot ) '[ _ 3 n&& ] ;
-   [ t ] [ N nnip ] 2array suffix
-   '[ f _ cond ] ;
 
-MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
+MACRO:: n|| ( quots n -- quot )
-MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
+    [ f ]
-MACRO: 2&& ( quots -- quot ) 2 n&&-rewrite ;
+    quots
-MACRO: 3&& ( quots -- quot ) 3 n&&-rewrite ;
+    [| q | { [ drop n ndup q call dup ] [ n nnip ] } ] map
+    { [ drop n ndrop t ] [ f ] } suffix 1array
+    [ cond ] 3append ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+MACRO: 0|| ( quots -- quot ) '[ _ 0 n|| ] ;
-
+MACRO: 1|| ( quots -- quot ) '[ _ 1 n|| ] ;
-:: n||-rewrite ( quots N -- quot )
+MACRO: 2|| ( quots -- quot ) '[ _ 2 n|| ] ;
-   quots
+MACRO: 3|| ( quots -- quot ) '[ _ 3 n|| ] ;
-     [ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
-   map
-   [ drop N ndrop t ] [ f ] 2array suffix
-   '[ f _ cond ] ;
-
-MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
-MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;
-MACRO: 2|| ( quots -- quot ) 2 n||-rewrite ;
-MACRO: 3|| ( quots -- quot ) 3 n||-rewrite ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

@@ -1,7 +1,5 @@
-
 USING: kernel sequences math stack-checker effects accessors macros
-       combinators.short-circuit ;
+fry combinators.short-circuit ;
-
 IN: combinators.short-circuit.smart
 
 <PRIVATE
@@ -13,6 +11,6 @@ IN: combinators.short-circuit.smart
 
 PRIVATE>
 
-MACRO: && ( quots -- quot ) dup arity n&&-rewrite ;
+MACRO: && ( quots -- quot ) dup arity '[ _ _ n&& ] ;
 
-MACRO: || ( quots -- quot ) dup arity n||-rewrite ;
+MACRO: || ( quots -- quot ) dup arity '[ _ _ n|| ] ;

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

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes classes.algebra classes.tuple
 classes.tuple.private kernel accessors math math.intervals
-namespaces sequences words combinators combinators.short-circuit
+namespaces sequences words combinators
 arrays compiler.tree.propagation.copy ;
 IN: compiler.tree.propagation.info
 
@@ -253,12 +253,13 @@ DEFER: (value-info-union)
         { [ over not ] [ 2drop f ] }
         [
             {
-                [ [ class>> ] bi@ class<= ]
+                { [ 2dup [ class>> ] bi@ class<= not ] [ f ] }
-                [ [ interval>> ] bi@ interval-subset? ]
+                { [ 2dup [ interval>> ] bi@ interval-subset? not ] [ f ] }
-                [ literals<= ]
+                { [ 2dup literals<= not ] [ f ] }
-                [ [ length>> ] bi@ value-info<= ]
+                { [ 2dup [ length>> ] bi@ value-info<= not ] [ f ] }
-                [ [ slots>> ] bi@ [ value-info<= ] 2all? ]
+                { [ 2dup [ slots>> ] bi@ [ value-info<= ] 2all? not ] [ f ] }
-            } 2&&
+                [ t ]
+            } cond 2nip
         ]
     } cond ;
 

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

@@ -138,6 +138,12 @@ most-negative-fixnum most-positive-fixnum [a,b]
 \ mod [ [ interval-mod ] [ real-valued ] binary-op ] each-derived-op
 \ rem [ [ interval-rem ] [ may-overflow real-valued ] binary-op ] each-derived-op
 
+{ /mod fixnum/mod } [
+    \ /i \ mod
+    [ "outputs" word-prop ] bi@
+    '[ _ _ 2bi ] "outputs" set-word-prop
+] each
+
 \ shift [ [ interval-shift-safe ] [ may-overflow integer-valued ] binary-op ] each-derived-op
 \ shift [ [ interval-shift-safe ] [ integer-valued ] binary-op ] each-fast-derived-op
 

basis/cpu/ppc/bootstrap.factor

@@ -335,6 +335,24 @@ big-endian on
     7 ds-reg 0 STW
 ] f f f \ fixnum-mod define-sub-primitive
 
+[
+    3 ds-reg 0 LWZ
+    ds-reg ds-reg 4 SUBI
+    4 ds-reg 0 LWZ
+    5 4 3 DIVW
+    5 ds-reg 0 STW
+] f f f \ fixnum/i-fast define-sub-primitive
+
+[
+    3 ds-reg 0 LWZ
+    4 ds-reg -4 LWZ
+    5 4 3 DIVW
+    6 5 3 MULLW
+    7 6 4 SUBF
+    5 ds-reg -4 STW
+    7 ds-reg 0 STW
+] f f f \ fixnum/mod-fast define-sub-primitive
+
 [
     3 ds-reg 0 LWZ
     3 3 1 SRAWI

basis/cpu/x86/bootstrap.factor

@@ -305,16 +305,33 @@ big-endian off
     ds-reg [] arg1 MOV                         ! push to stack
 ] f f f \ fixnum-shift-fast define-sub-primitive
 
-[
+: jit-fixnum-/mod
     temp-reg ds-reg [] MOV                     ! load second parameter
-    ds-reg bootstrap-cell SUB                  ! adjust stack pointer
+    div-arg ds-reg bootstrap-cell neg [+] MOV  ! load first parameter
-    div-arg ds-reg [] MOV                      ! load first parameter
     mod-arg div-arg MOV                        ! make a copy
     mod-arg bootstrap-cell-bits 1- SAR         ! sign-extend
-    temp-reg IDIV                              ! divide
+    temp-reg IDIV ;                            ! divide
+
+[
+    jit-fixnum-/mod
+    ds-reg bootstrap-cell SUB                  ! adjust stack pointer
     ds-reg [] mod-arg MOV                      ! push to stack
 ] f f f \ fixnum-mod define-sub-primitive
 
+[
+    jit-fixnum-/mod
+    ds-reg bootstrap-cell SUB                  ! adjust stack pointer
+    div-arg tag-bits get SHL                   ! tag it
+    ds-reg [] div-arg MOV                      ! push to stack
+] f f f \ fixnum/i-fast define-sub-primitive
+
+[
+    jit-fixnum-/mod
+    div-arg tag-bits get SHL                   ! tag it
+    ds-reg [] mod-arg MOV                      ! push to stack
+    ds-reg bootstrap-cell neg [+] div-arg MOV
+] f f f \ fixnum/mod-fast define-sub-primitive
+
 [
     arg0 ds-reg [] MOV                         ! load local number
     fixnum>slot@                               ! turn local number into offset

basis/editors/notepad2/authors.txt

@@ -0,0 +1 @@
+Marc Fauconneau

basis/editors/notepad2/notepad2.factor

@@ -0,0 +1,16 @@
+USING: editors io.files io.launcher kernel math.parser
+namespaces sequences windows.shell32 make ;
+IN: editors.notepad2
+
+: notepad2-path ( -- str )
+    \ notepad2-path get-global [
+        program-files "C:\\Windows\\system32\\notepad.exe" append-path
+   ] unless* ;
+
+: notepad2 ( file line -- )
+    [
+        notepad2-path ,
+        "/g" , number>string , ,
+    ] { } make run-detached drop ;
+
+[ notepad2 ] edit-hook set-global

basis/editors/notepad2/summary.txt

@@ -0,0 +1 @@
+Notepad2 editor integration

basis/editors/notepad2/tags.txt

@@ -0,0 +1 @@
+unportable

basis/fry/fry-docs.factor

@@ -19,6 +19,9 @@ HELP: '[
 { $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" } "." } ;
 
+HELP: >r/r>-in-fry-error
+{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ;
+
 ARTICLE: "fry.examples" "Examples of fried quotations"
 "The easiest way to understand fried quotations is to look at some examples."
 $nl
@@ -73,7 +76,10 @@ ARTICLE: "fry.philosophy" "Fried quotation philosophy"
 } ;
 
 ARTICLE: "fry.limitations" "Fried quotation limitations"
-"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead." ;
+"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead."
+$nl
+"An error thrown if a fried quotation contains calls to " { $link >r } " and " { $link r> } ":"
+{ $subsection >r/r>-in-fry-error } ;
 
 ARTICLE: "fry" "Fried quotations"
 "The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with ``holes'' (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack."

basis/fry/fry-tests.factor

@@ -1,23 +1,20 @@
 IN: fry.tests
 USING: fry tools.test math prettyprint kernel io arrays
-sequences ;
+sequences eval accessors ;
 
 [ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
 
 [ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
 
-[ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
+[ [ 1 [ + ] call ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
 
-[ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
+[ [ 1 [ + ] call . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
 
-[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
+[ [ [ + ] [ - ] [ call ] dip call ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
 
-[ [ "a" write "b" print ] ]
+[ [ "a" "b" [ write ] dip print ] ]
 [ "a" "b" '[ _ write _ print ] ] unit-test
 
-[ [ 1 2 + 3 4 - ] ]
-[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
-
 [ 1/2 ] [
     1 '[ [ _ ] dip / ] 2 swap call
 ] unit-test
@@ -58,3 +55,10 @@ sequences ;
 [ { { { 3 } } } ] [
     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
 ] unit-test
+
+[ "USING: fry kernel ; f '[ >r _ r> ]" eval ]
+[ error>> >r/r>-in-fry-error? ] must-fail-with
+
+[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
+    1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
+] unit-test

basis/fry/fry.factor

@@ -1,33 +1,37 @@
 ! 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 make words ;
+quotations arrays make words locals.backend summary sets ;
 IN: fry
 
 : _ ( -- * ) "Only valid inside a fry" throw ;
 : @ ( -- * ) "Only valid inside a fry" throw ;
 
+ERROR: >r/r>-in-fry-error ;
+
 <PRIVATE
 
-DEFER: (shallow-fry)
+: [ncurry] ( n -- quot )
-DEFER: shallow-fry
+    {
+        { 0 [ [ ] ] }
+        { 1 [ [ curry ] ] }
+        { 2 [ [ 2curry ] ] }
+        { 3 [ [ 3curry ] ] }
+        [ \ curry <repetition> ]
+    } case ;
 
-: ((shallow-fry)) ( accum quot adder -- result )
+M: >r/r>-in-fry-error summary
-    >r shallow-fry r>
+    drop
-    append swap [
+    "Explicit retain stack manipulation is not permitted in fried quotations" ;
-        [ prepose ] curry append
-    ] unless-empty ; inline
 
-: (shallow-fry) ( accum quot -- result )
+: check-fry ( quot -- quot )
-    [ 1quotation ] [
+    dup { >r r> load-locals get-local drop-locals } intersect
-        unclip {
+    empty? [ >r/r>-in-fry-error ] unless ;
-            { \ _ [ [ curry ] ((shallow-fry)) ] }
-            { \ @ [ [ compose ] ((shallow-fry)) ] }
-            [ swap >r suffix r> (shallow-fry) ]
-        } case
-    ] if-empty ;
 
-: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
+: shallow-fry ( quot -- quot' )
+    check-fry
+    [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
+    { _ } split [ length 1- [ncurry] ] [ spread>quot ] bi prefix ;
 
 PREDICATE: fry-specifier < word { _ @ } memq? ;
 

basis/generalizations/generalizations-tests.factor

@@ -36,3 +36,5 @@ IN: generalizations.tests
 [ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test
 [ ] [ { } 0 firstn ] unit-test
 [ "a" ] [ { "a" } 1 firstn ] unit-test
+
+[ [ 1 2 ] ] [ 1 2 2 [ ] nsequence ] unit-test

basis/generalizations/generalizations.factor

@@ -6,8 +6,11 @@ math.ranges combinators macros quotations fry arrays ;
 IN: generalizations
 
 MACRO: nsequence ( n seq -- quot )
-    [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
+    [
-    [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce ;
+        [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
+        [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
+    ] keep
+    '[ @ _ like ] ;
 
 MACRO: narray ( n -- quot )
     '[ _ { } nsequence ] ;

basis/locals/locals-docs.factor

@@ -132,8 +132,8 @@ $nl
 "Unlike some languages such as Python and Java, writing to mutable locals in outer scopes is fully supported and has the expected semantics." ;
 
 ARTICLE: "locals-limitations" "Limitations of locals"
-"The first limitation is that the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator."
+"The first limitation is also shared by " { $vocab-link "fry" } ": the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator. An error is thrown at parse time if an attempt is made to use " { $link >r } " and " { $link r> } " inside a lambda body:"
-$nl
+{ $subsection >r/r>-in-lambda-error }
 "Another limitation concerns combinators implemented as macros. Locals can only be used with such combinators if the input array immediately precedes the combinator call. For example, the following will work:"
 { $code
     ":: good-cond-usage ( a -- ... )"

basis/locals/locals-tests.factor

@@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
 namespaces arrays strings prettyprint io.streams.string parser
 accessors generic eval combinators combinators.short-circuit
 combinators.short-circuit.smart math.order math.functions
-definitions compiler.units ;
+definitions compiler.units fry ;
 IN: locals.tests
 
 :: foo ( a b -- a a ) a a ;
@@ -286,6 +286,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
         { [ a b > ] [ 5 ] }
     } cond ;
 
+\ cond-test must-infer
+
 [ 3 ] [ 1 2 cond-test ] unit-test
 [ 4 ] [ 2 2 cond-test ] unit-test
 [ 5 ] [ 3 2 cond-test ] unit-test
@@ -293,6 +295,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 :: 0&&-test ( a -- ? )
     { [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ;
 
+\ 0&&-test must-infer
+
 [ f ] [ 1.5 0&&-test ] unit-test
 [ f ] [ 3 0&&-test ] unit-test
 [ f ] [ 8 0&&-test ] unit-test
@@ -301,6 +305,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 :: &&-test ( a -- ? )
     { [ a integer? ] [ a even? ] [ a 10 > ] } && ;
 
+\ &&-test must-infer
+
 [ f ] [ 1.5 &&-test ] unit-test
 [ f ] [ 3 &&-test ] unit-test
 [ f ] [ 8 &&-test ] unit-test
@@ -346,6 +352,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 
 { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
 
+ERROR: punned-class x ;
+
+[ T{ punned-class f 3 } ] [ 3 [| a | T{ punned-class f a } ] call ] unit-test
+
 :: literal-identity-test ( -- a b )
     { } V{ } ;
 
@@ -390,6 +400,18 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test
 
+[
+    "USING: locals fry math ; [ 0 '[ [let | A [ 10 ] | A _ + ] ] ]" eval
+] [ error>> >r/r>-in-fry-error? ] must-fail-with
+
+:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
+: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
+
+\ funny-macro-test must-infer
+
+[ t ] [ 3 funny-macro-test ] unit-test
+[ f ] [ 2 funny-macro-test ] unit-test
+
 ! :: wlet-&&-test ( a -- ? )
 !     [wlet | is-integer? [ a integer? ]
 !             is-even? [ a even? ]

basis/locals/locals.factor

@@ -6,12 +6,18 @@ quotations debugger macros arrays macros splitting combinators
 prettyprint.backend definitions prettyprint hashtables
 prettyprint.sections sets sequences.private effects
 effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer classes ;
+locals.backend memoize macros.expander lexer classes summary ;
 IN: locals
 
 ! Inspired by
 ! http://cat-language.googlecode.com/svn/trunk/CatPointFreeForm.cs
 
+ERROR: >r/r>-in-lambda-error ;
+
+M: >r/r>-in-lambda-error summary
+    drop
+    "Explicit retain stack manipulation is not permitted in lambda bodies" ;
+
 <PRIVATE
 
 TUPLE: lambda vars body ;
@@ -141,20 +147,17 @@ GENERIC: free-vars* ( form -- )
 : free-vars ( form -- vars )
     [ free-vars* ] { } make prune ;
 
-: add-if-free ( object -- )
+M: local-writer free-vars* "local-reader" word-prop , ;
-    {
+
-        { [ dup local-writer? ] [ "local-reader" word-prop , ] }
+M: lexical free-vars* , ;
-        { [ dup lexical? ] [ , ] }
+
-        { [ dup quote? ] [ local>> , ] }
+M: quote free-vars* , ;
-        { [ t ] [ free-vars* ] }
-    } cond ;
 
 M: object free-vars* drop ;
 
-M: quotation free-vars* [ add-if-free ] each ;
+M: quotation free-vars* [ free-vars* ] each ;
 
-M: lambda free-vars*
+M: lambda free-vars* [ vars>> ] [ body>> ] bi free-vars swap diff % ;
-    [ vars>> ] [ body>> ] bi free-vars swap diff % ;
 
 GENERIC: lambda-rewrite* ( obj -- )
 
@@ -201,6 +204,8 @@ M: special rewrite-literal? drop t ;
 
 M: array rewrite-literal? [ rewrite-literal? ] contains? ;
 
+M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
+
 M: hashtable rewrite-literal? drop t ;
 
 M: vector rewrite-literal? drop t ;
@@ -215,17 +220,20 @@ GENERIC: rewrite-element ( obj -- )
     [ rewrite-element ] each ;
 
 : rewrite-sequence ( seq -- )
-    [ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ;
+    [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
 
 M: array rewrite-element
     dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
 
+M: quotation rewrite-element
+    dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
+
 M: vector rewrite-element rewrite-sequence ;
 
 M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 
 M: tuple rewrite-element
-    [ tuple-slots rewrite-elements ] [ class , ] bi \ boa , ;
+    [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
 
 M: local rewrite-element , ;
 
@@ -243,6 +251,10 @@ M: tuple local-rewrite* rewrite-element ;
 
 M: hashtable local-rewrite* rewrite-element ;
 
+M: word local-rewrite*
+    dup { >r r> } memq?
+    [ >r/r>-in-lambda-error ] [ call-next-method ] if ;
+
 M: object lambda-rewrite* , ;
 
 M: object local-rewrite* , ;

basis/macros/expander/expander.factor

@@ -37,9 +37,17 @@ M: wrapper expand-macros* wrapped>> literal ;
         [ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
     ] bi ;
 
-: expand-macro ( quot -- )
+: word, ( word -- ) end , ;
-    stack [ swap with-datastack >vector ] change
+
-    stack get pop >quotation end (expand-macros) ;
+: expand-macro ( word quot -- )
+    '[
+        drop
+        stack [ _ with-datastack >vector ] change
+        stack get pop >quotation end (expand-macros)
+    ] [
+        drop
+        word,
+    ] recover ;
 
 : expand-macro? ( word -- quot ? )
     dup [ "transform-quot" word-prop ] [ "macro" word-prop ] bi or dup [
@@ -47,11 +55,9 @@ M: wrapper expand-macros* wrapped>> literal ;
         stack get length <=
     ] [ 2drop f f ] if ;
 
-: word, ( word -- ) end , ;
-
 M: word expand-macros*
     dup expand-dispatch? [ drop expand-dispatch ] [
-        dup expand-macro? [ nip expand-macro ] [
+        dup expand-macro? [ expand-macro ] [
             drop word,
         ] if
     ] if ;

basis/math/partial-dispatch/partial-dispatch.factor

@@ -29,6 +29,8 @@ M: word integer-op-input-classes
         { fixnum- fixnum-fast }
         { fixnum* fixnum*fast }
         { fixnum-shift fixnum-shift-fast }
+        { fixnum/i fixnum/i-fast }
+        { fixnum/mod fixnum/mod-fast }
     } at ;
 
 : modular-variant ( op -- fast-op )

basis/prettyprint/backend/backend.factor

@@ -216,27 +216,8 @@ M: object pprint* pprint-object ;
 M: vector pprint* pprint-object ;
 M: byte-vector pprint* pprint-object ;
 M: hashtable pprint* pprint-object ;
-
+M: curry pprint* pprint-object ;
-GENERIC: valid-callable? ( obj -- ? )
+M: compose pprint* pprint-object ;
-
-M: object valid-callable? drop f ;
-
-M: quotation valid-callable? drop t ;
-
-M: curry valid-callable? quot>> valid-callable? ;
-
-M: compose valid-callable?
-    [ first>> ] [ second>> ] bi [ valid-callable? ] both? ;
-
-M: curry pprint*
-    dup valid-callable? [ pprint-object ] [
-        "( invalid curry )" swap present-text
-    ] if ;
-
-M: compose pprint*
-    dup valid-callable? [ pprint-object ] [
-        "( invalid compose )" swap present-text
-    ] if ;
 
 M: wrapper pprint*
     dup wrapped>> word? [

basis/prettyprint/prettyprint-tests.factor

@@ -323,10 +323,6 @@ M: class-see-layout class-see-layout ;
     [ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
 ] unit-test
 
-[ ] [ 1 \ + curry unparse drop ] unit-test
-
-[ ] [ 1 \ + compose unparse drop ] unit-test
-
 GENERIC: generic-see-test-with-f ( obj -- obj )
 
 M: f generic-see-test-with-f ;
@@ -365,8 +361,3 @@ M: started-out-hustlin' ended-up-ballin' ; inline
 [ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
     [ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer
 ] unit-test
-
-[ "( invalid curry )" ] [ 1 2 curry unparse ] unit-test
-[ "( invalid curry )" ] [ 1 2 3 curry curry unparse ] unit-test
-[ "( invalid compose )" ] [ 1 2 compose unparse ] unit-test
-[ "( invalid compose )" ] [ [ 1 ] 2 3 curry compose unparse ] unit-test

core/bootstrap/primitives.factor

@@ -303,7 +303,13 @@ tuple
     [ f "inline" set-word-prop ]
     [ make-flushable ]
     [ ]
-    [ tuple-layout [ <tuple-boa> ] curry ]
+    [
+        [
+            callable instance-check-quot %
+            tuple-layout ,
+            \ <tuple-boa> ,
+        ] [ ] make
+    ]
 } cleave
 (( obj quot -- curry )) define-declared
 
@@ -319,7 +325,16 @@ tuple
     [ f "inline" set-word-prop ]
     [ make-flushable ]
     [ ]
-    [ tuple-layout [ <tuple-boa> ] curry ]
+    [
+        [
+            \ >r ,
+            callable instance-check-quot %
+            \ r> ,
+            callable instance-check-quot %
+            tuple-layout ,
+            \ <tuple-boa> ,
+        ] [ ] make
+    ]
 } cleave
 (( quot1 quot2 -- compose )) define-declared
 
@@ -341,6 +356,8 @@ tuple
     { "fixnum-bitnot" "math.private" }
     { "fixnum-mod" "math.private" }
     { "fixnum-shift-fast" "math.private" }
+    { "fixnum/i-fast" "math.private" }
+    { "fixnum/mod-fast" "math.private" }
     { "fixnum<" "math.private" }
     { "fixnum<=" "math.private" }
     { "fixnum>" "math.private" }

core/classes/tuple/tuple.factor

@@ -121,7 +121,7 @@ ERROR: bad-superclass class ;
     [
         \ dup ,
         [ "predicate" word-prop % ]
-        [ [ bad-slot-value ] curry , ] bi
+        [ [ literalize , \ bad-slot-value , ] [ ] make , ] bi
         \ unless ,
     ] [ ] make ;
 

core/combinators/combinators.factor

@@ -28,10 +28,7 @@ IN: combinators
 
 ! spread
 : spread>quot ( seq -- quot )
-    [ ] [
+    [ ] [ [ dup empty? [ [ dip ] curry ] unless ] dip append ] reduce ;
-        [ dup empty? [ [ >r ] swap [ r> ] 3append ] unless ] dip
-        append
-    ] reduce ;
 
 : spread ( objs... seq -- )
     spread>quot call ;

core/parser/parser-tests.factor

@@ -2,7 +2,7 @@ USING: arrays math parser tools.test kernel generic words
 io.streams.string namespaces classes effects source-files
 assocs sequences strings io.files definitions continuations
 sorting classes.tuple compiler.units debugger vocabs
-vocabs.loader accessors eval combinators ;
+vocabs.loader accessors eval combinators lexer ;
 IN: parser.tests
 
 [

core/quotations/quotations-tests.factor

@@ -15,4 +15,4 @@ IN: quotations.tests
 
 [ [ "hi" ] ] [ "hi" 1quotation ] unit-test
 
-! [ 1 \ + curry ] must-fail
+[ 1 \ + curry ] must-fail

extra/display-stack/display-stack.factor

@@ -1,43 +0,0 @@
-
-USING: kernel namespaces sequences math
-       listener io prettyprint sequences.lib bake bake.fry ;
-
-IN: display-stack
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: watched-variables
-
-: watch-var ( sym -- ) watched-variables get push ;
-
-: watch-vars ( seq -- ) watched-variables get [ push ] curry each ;
-
-: unwatch-var ( sym -- ) watched-variables get delete ;
-
-: unwatch-vars ( seq -- ) watched-variables get [ delete ] curry each ;
-
-: print-watched-variables ( -- )
-  watched-variables get length 0 >
-    [
-      "----------" print
-      watched-variables get
-        watched-variables get [ unparse ] map longest length 2 +
-        '[ [ unparse ": " append , 32 pad-right write ] [ get . ] bi ]
-      each
-
-    ]
-  when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: display-stack ( -- )
-  V{ } clone watched-variables set
-    [
-      print-watched-variables
-      "----------" print
-      datastack [ . ] each
-      "----------" print
-      retainstack reverse [ . ] each
-    ]
-  listener-hook set ;
-

vm/math.c

@@ -33,18 +33,18 @@ void primitive_float_to_fixnum(void)
 
 #define POP_FIXNUMS(x,y) \
 	F_FIXNUM y = untag_fixnum_fast(dpop()); \
-	F_FIXNUM x = untag_fixnum_fast(dpop());
+	F_FIXNUM x = untag_fixnum_fast(dpeek());
 
 void primitive_fixnum_add(void)
 {
 	POP_FIXNUMS(x,y)
-	box_signed_cell(x + y);
+	drepl(allot_integer(x + y));
 }
 
 void primitive_fixnum_subtract(void)
 {
 	POP_FIXNUMS(x,y)
-	box_signed_cell(x - y);
+	drepl(allot_integer(x - y));
 }
 
 /* Multiply two integers, and trap overflow.
@@ -54,20 +54,20 @@ void primitive_fixnum_multiply(void)
 	POP_FIXNUMS(x,y)
 
 	if(x == 0 || y == 0)
-		dpush(tag_fixnum(0));
+		drepl(tag_fixnum(0));
 	else
 	{
 		F_FIXNUM prod = x * y;
 		/* if this is not equal, we have overflow */
 		if(prod / x == y)
-			box_signed_cell(prod);
+			drepl(allot_integer(prod));
 		else
 		{
 			F_ARRAY *bx = fixnum_to_bignum(x);
 			REGISTER_BIGNUM(bx);
 			F_ARRAY *by = fixnum_to_bignum(y);
 			UNREGISTER_BIGNUM(bx);
-			dpush(tag_bignum(bignum_multiply(bx,by)));
+			drepl(tag_bignum(bignum_multiply(bx,by)));
 		}
 	}
 }
@@ -75,14 +75,27 @@ void primitive_fixnum_multiply(void)
 void primitive_fixnum_divint(void)
 {
 	POP_FIXNUMS(x,y)
-	box_signed_cell(x / y);
+	F_FIXNUM result = x / y;
+	if(result == -FIXNUM_MIN)
+		drepl(allot_integer(-FIXNUM_MIN));
+	else
+		drepl(tag_fixnum(result));
 }
 
 void primitive_fixnum_divmod(void)
 {
-	POP_FIXNUMS(x,y)
+	F_FIXNUM y = get(ds);
-	box_signed_cell(x / y);
+	F_FIXNUM x = get(ds - CELLS);
-	dpush(tag_fixnum(x % y));
+	if(y == tag_fixnum(-1) && x == tag_fixnum(FIXNUM_MIN))
+	{
+		put(ds - CELLS,allot_integer(-FIXNUM_MIN));
+		put(ds,tag_fixnum(0));
+	}
+	else
+	{
+		put(ds - CELLS,tag_fixnum(x / y));
+		put(ds,x % y);
+	}
 }
 
 /*
@@ -96,15 +109,15 @@ void primitive_fixnum_shift(void)
 
 	if(x == 0 || y == 0)
 	{
-		dpush(tag_fixnum(x));
+		drepl(tag_fixnum(x));
 		return;
 	}
 	else if(y < 0)
 	{
 		if(y <= -WORD_SIZE)
-			dpush(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
+			drepl(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
 		else
-			dpush(tag_fixnum(x >> -y));
+			drepl(tag_fixnum(x >> -y));
 		return;
 	}
 	else if(y < WORD_SIZE - TAG_BITS)
@@ -112,12 +125,12 @@ void primitive_fixnum_shift(void)
 		F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y));
 		if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
 		{
-			dpush(tag_fixnum(x << y));
+			drepl(tag_fixnum(x << y));
 			return;
 		}
 	}
 
-	dpush(tag_bignum(bignum_arithmetic_shift(
+	drepl(tag_bignum(bignum_arithmetic_shift(
 		fixnum_to_bignum(x),y)));
 }