Fix conflict

core/classes/classes-tests.factor

@@ -207,3 +207,14 @@ DEFER: mixin-forget-test-g
 
 [ { } mixin-forget-test-g ] unit-test-fails
 [ H{ } ] [ H{ } mixin-forget-test-g ] unit-test
+
+! Method flattening interfered with mixin update
+MIXIN: flat-mx-1
+TUPLE: flat-mx-1-1 ; INSTANCE: flat-mx-1-1 flat-mx-1
+TUPLE: flat-mx-1-2 ; INSTANCE: flat-mx-1-2 flat-mx-1
+TUPLE: flat-mx-1-3 ; INSTANCE: flat-mx-1-3 flat-mx-1
+TUPLE: flat-mx-1-4 ; INSTANCE: flat-mx-1-4 flat-mx-1
+MIXIN: flat-mx-2     INSTANCE: flat-mx-2 flat-mx-1
+TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
+
+[ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test

core/compiler/test/redefine.factor

@@ -238,3 +238,15 @@ DEFER: flushable-test-2
 [ \ bx forget ] with-compilation-unit
 
 [ t ] [ \ ax compiled-usage [ drop interned? ] assoc-all? ] unit-test
+
+DEFER: defer-redefine-test-2
+
+[ ] [ "IN: temporary DEFER: defer-redefine-test-1" eval ] unit-test
+
+[ ] [ "IN: temporary : defer-redefine-test-2 defer-redefine-test-1 1 ;" eval ] unit-test
+
+[ defer-redefine-test-2 ] unit-test-fails
+
+[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
+
+[ 1 ] [ defer-redefine-test-2 ] unit-test

extra/const/const.factor

@@ -14,3 +14,11 @@ IN: const
 
 : ENUM:
     ";" parse-tokens [ create-in ] map define-enum ; parsing
+
+: define-value ( word -- )
+    { f } clone [ first ] curry define ;
+
+: VALUE: CREATE define-value ; parsing
+
+: set-value ( value word -- )
+    word-def first set-first ;

extra/unicode/breaks/breaks.factor

@@ -1,7 +1,7 @@
 USING: unicode.categories kernel math combinators splitting
 sequences math.parser io.files io assocs arrays namespaces
 combinators.lib assocs.lib math.ranges unicode.normalize
-unicode.syntax unicode.data compiler.units alien.syntax ;
+unicode.syntax unicode.data compiler.units alien.syntax const ;
 IN: unicode.breaks
 
 C-ENUM: Any L V T Extend Control CR LF graphemes ;
@@ -32,7 +32,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ;
 : other-extend-lines ( -- lines )
     "extra/unicode/PropList.txt" resource-path file-lines ;
 
-DEFER: other-extend
+VALUE: other-extend
 
 CATEGORY: (extend) Me Mn ;
 : extend? ( ch -- ? )
@@ -77,7 +77,7 @@ SYMBOL: table
     T T connect
     graphemes Extend connect-after ;
 
-DEFER: grapheme-table
+VALUE: grapheme-table
 
 : grapheme-break? ( class1 class2 -- ? )
     grapheme-table nth nth not ;
@@ -113,10 +113,10 @@ DEFER: grapheme-table
     [ grapheme-class dup rot grapheme-break? ] find-last-index
     nip -1 or 1+ ;
 
-<<
+[
-    other-extend-lines process-other-extend \ other-extend define-value
+    other-extend-lines process-other-extend \ other-extend set-value
 
     init-grapheme-table table
     [ make-grapheme-table finish-table ] with-variable
-    \ grapheme-table define-value
+    \ grapheme-table set-value
->>
+] with-compilation-unit

extra/unicode/data/data.factor

@@ -1,15 +1,12 @@
 USING: assocs math kernel sequences io.files hashtables
 quotations splitting arrays math.parser combinators.lib hash2
-byte-arrays words namespaces words compiler.units ;
+byte-arrays words namespaces words compiler.units const ;
 IN: unicode.data
 
 ! Convenience functions
 : 1+* ( n/f _ -- n+1 )
     drop [ 1+ ] [ 0 ] if* ;
 
-: define-value ( value word -- )
-    swap 1quotation define ;
-
 : ?between? ( n/f from to -- ? )
     pick [ between? ] [ 3drop f ] if ;
 
@@ -107,16 +104,16 @@ C: <code-point> code-point
     4 head [ multihex ] map first4
     <code-point> swap first set ;
 
-DEFER: simple-lower
+VALUE: simple-lower
-DEFER: simple-upper
+VALUE: simple-upper
-DEFER: simple-title
+VALUE: simple-title
-DEFER: canonical-map
+VALUE: canonical-map
-DEFER: combine-map
+VALUE: combine-map
-DEFER: class-map
+VALUE: class-map
-DEFER: compat-map
+VALUE: compat-map
-DEFER: category-map
+VALUE: category-map
-DEFER: name-map
+VALUE: name-map
-DEFER: special-casing
+VALUE: special-casing
 
 : canonical-entry ( char -- seq ) canonical-map at ;
 : combine-chars ( a b -- char/f ) combine-map hash2 ;
@@ -132,16 +129,14 @@ DEFER: special-casing
     [ length 5 = ] subset
     [ [ set-code-point ] each ] H{ } make-assoc ;
 
-[
 load-data
-    dup process-names \ name-map define-value
+dup process-names \ name-map set-value
-    13 over process-data \ simple-lower define-value
+13 over process-data \ simple-lower set-value
-    12 over process-data tuck \ simple-upper define-value
+12 over process-data tuck \ simple-upper set-value
-    14 over process-data swapd union \ simple-title define-value
+14 over process-data swapd union \ simple-title set-value
-    dup process-combining \ class-map define-value
+dup process-combining \ class-map set-value
-    dup process-canonical \ canonical-map define-value
+dup process-canonical \ canonical-map set-value
-        \ combine-map define-value
+    \ combine-map set-value
-    dup process-compat \ compat-map define-value
+dup process-compat \ compat-map set-value
-    process-category \ category-map define-value
+process-category \ category-map set-value
-    load-special-casing \ special-casing define-value
+load-special-casing \ special-casing set-value
-] with-compilation-unit

extra/unicode/normalize/normalize.factor

@@ -2,7 +2,7 @@ USING: sequences namespaces unicode.data kernel combinators.lib
 math arrays ;
 IN: unicode.normalize
 
-! Utility word
+! Utility word--probably unnecessary
 : make* ( seq quot exemplar -- newseq )
     ! quot has access to original seq on stack
     ! this just makes the new-resizable the same length as seq
@@ -89,7 +89,7 @@ IN: unicode.normalize
         swap [ [
             dup hangul? [ hangul>jamo % drop ]
             [ dup rot call [ % ] [ , ] ?if ] if
-        ] with each ] "" make*
+        ] with each ] "" make
         dup reorder
     ] if ; inline
 
@@ -167,7 +167,7 @@ SYMBOL: char
         0 ind set
         SBUF" " clone after set
         pass-combining (compose)
-    ] "" make* ;
+    ] "" make ;
 
 : nfc ( string -- nfc )
     nfd compose ;

extra/unicode/syntax/syntax.factor

@@ -1,5 +1,5 @@
 USING: unicode.data kernel math sequences parser bit-arrays namespaces 
-sequences.private arrays quotations classes.predicate ;
+sequences.private arrays quotations classes.predicate assocs ;
 IN: unicode.syntax
 
 ! Character classes (categories)
@@ -48,5 +48,5 @@ IN: unicode.syntax
     categories swap seq-minus define-category ; parsing
 
 : UNICHAR:
-    ! This should be part of CHAR:
+    ! This should be part of CHAR:. Also, name-map at ==> name>char
     scan name>char [ parsed ] [ "Invalid character" throw ] if* ; parsing

extra/xml/entities/entities.factor

@@ -1,8 +1,32 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel ;
+USING: namespaces kernel assocs sequences ;
 IN: xml.entities
 
+: entities-out
+    H{
+        { CHAR: < "&lt;"   }
+        { CHAR: > "&gt;"   }
+        { CHAR: & "&amp;"  }
+    } ;
+
+: quoted-entities-out
+    H{
+        { CHAR: & "&amp;"  }
+        { CHAR: ' "&apos;" }
+        { CHAR: " "&quot;" }
+    } ;
+
+: escape-string-by ( str table -- escaped )
+    #! Convert <, >, &, ' and " to HTML entities.
+    [ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
+
+: escape-string ( str -- newstr )
+    entities-out escape-string-by ;
+
+: escape-quoted-string ( str -- newstr )
+    quoted-entities-out escape-string-by ;
+
 : entities
     H{
         { "lt"    CHAR: <  }

extra/xml/test/templating.factor

@@ -1,4 +1,3 @@
-IN: templating
 USING: kernel xml sequences assocs tools.test io arrays namespaces
     xml.data xml.utilities xml.writer generic sequences.deep ;
 
@@ -9,10 +8,10 @@ SYMBOL: ref-table
 
 GENERIC: (r-ref) ( xml -- )
 M: tag (r-ref)
-    sub-tag over at [
+    sub-tag over at* [
         ref-table get at
         swap set-tag-children
-    ] [ drop ] if* ;
+    ] [ 2drop ] if ;
 M: object (r-ref) drop ;
 
 : template ( xml -- )
@@ -40,4 +39,4 @@ M: object (r-ref) drop ;
         sample-doc string>xml dup template xml>string
     ] with-scope ;
 
-[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test
+[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><html xmlns:f=\"http://littledan.onigirihouse.com/namespaces/replace\"><body><span f:sub=\"foo\">foo</span><div f:sub=\"bar\">blah<a/></div><p f:sub=\"baz\"/></body></html>" ] [ test-refs ] unit-test

extra/xml/test/test.factor

@@ -26,7 +26,7 @@ SYMBOL: xml-file
 ] unit-test
 [ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test
 [ "that" ] [ xml-file get "this" swap at ] unit-test
-[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<a b=\"c\"/>" ]
+[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><a b=\"c\"/>" ]
     [ "<a b='c'/>" string>xml xml>string ] unit-test
 [ "abcd" ] [
     "<main>a<sub>bc</sub>d<nothing/></main>" string>xml
@@ -44,7 +44,7 @@ SYMBOL: xml-file
     at swap "z" >r tuck r> swap set-at
     T{ name f "blah" "z" f } swap at ] unit-test
 [ "foo" ] [ "<boo><![CDATA[foo]]></boo>" string>xml children>string ] unit-test
-[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<foo>bar baz</foo>" ]
+[ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?><foo>bar baz</foo>" ]
 [ "<foo>bar</foo>" string>xml [ " baz" append ] map xml>string ] unit-test
 [ "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>\n<foo>\n  bar\n</foo>" ]
 [ "<foo>         bar            </foo>" string>xml pprint-xml>string ] unit-test

extra/xml/writer/writer.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables kernel math namespaces sequences strings
-io io.streams.string xml.data assocs ;
+io io.streams.string xml.data assocs wrap xml.entities ;
 IN: xml.writer
 
 SYMBOL: xml-pprint?
@@ -13,10 +13,13 @@ SYMBOL: indenter
 : sensitive? ( tag -- ? )
     sensitive-tags get swap [ names-match? ] curry contains? ;
 
+: indent-string ( -- string )
+    xml-pprint? get
+    [ indentation get indenter get <repetition> concat ]
+    [ "" ] if ;
+
 : ?indent ( -- )
-    xml-pprint? get [
+    xml-pprint? get [ nl indent-string write ] when ;
-        nl indentation get indenter get <repetition> [ write ] each
-    ] when ;
 
 : indent ( -- )
     xml-pprint? get [ 1 indentation +@ ] when ;
@@ -35,30 +38,6 @@ SYMBOL: indenter
         [ dup empty? swap string? and not ] subset
     ] when ;
 
-: entities-out
-    H{
-        { CHAR: < "&lt;"   }
-        { CHAR: > "&gt;"   }
-        { CHAR: & "&amp;"  }
-    } ;
-
-: quoted-entities-out
-    H{
-        { CHAR: & "&amp;"  }
-        { CHAR: ' "&apos;" }
-        { CHAR: " "&quot;" }
-    } ;
-
-: escape-string-by ( str table -- escaped )
-    #! Convert <, >, &, ' and " to HTML entities.
-    [ [ dupd at [ % ] [ , ] ?if ] curry each ] "" make ;
-
-: escape-string ( str -- newstr )
-    entities-out escape-string-by ;
-
-: escape-quoted-string ( str -- newstr )
-    quoted-entities-out escape-string-by ;
-
 : print-name ( name -- )
     dup name-space f like
     [ write CHAR: : write1 ] when*
@@ -76,10 +55,11 @@ SYMBOL: indenter
 GENERIC: write-item ( object -- )
 
 M: string write-item
-    escape-string write ;
+    escape-string dup empty? not xml-pprint? get and
+    [ nl 80 indent-string indented-break ] when write ;
 
 : write-tag ( tag -- )
-    CHAR: < write1
+    ?indent CHAR: < write1
     dup print-name tag-attrs print-attrs ;
 
 M: contained-tag write-item
@@ -87,7 +67,7 @@ M: contained-tag write-item
 
 : write-children ( tag -- )
     indent tag-children ?filter-children
-    [ ?indent write-item ] each unindent ;
+    [ write-item ] each unindent ;
 
 : write-end-tag ( tag -- )
     ?indent "</" write print-name CHAR: > write1 ;
@@ -112,7 +92,7 @@ M: instruction write-item
     "<?xml version=\"" write dup prolog-version write
     "\" encoding=\"" write dup prolog-encoding write
     prolog-standalone [ "\" standalone=\"yes" write ] when
-    "\"?>\n" write ;
+    "\"?>" write ;
 
 : write-chunk ( seq -- )
     [ write-item ] each ;