Fix conflict in libc

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 make libc cpu.architecture ;
+sequences math kernel namespaces fry libc cpu.architecture ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -10,7 +10,7 @@ M: array c-type ;
 
 M: array c-type-class drop object ;
 
-M: array heap-size unclip heap-size [ * ] reduce ;
+M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
 
 M: array c-type-align first c-type-align ;
 
@@ -26,16 +26,15 @@ M: array box-return drop "void*" box-return ;
 
 M: array stack-size drop "void*" stack-size ;
 
+M: array c-type-boxer-quot drop f ;
+
+M: array c-type-unboxer-quot drop [ >c-ptr ] ;
+
 M: value-type c-type-reg-class drop int-regs ;
 
-M: value-type c-type-boxer-quot drop f ;
-
-M: value-type c-type-unboxer-quot drop f ;
-
 M: value-type c-type-getter
     drop [ swap <displaced-alien> ] ;
 
 M: value-type c-type-setter ( type -- quot )
-    [
+    [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
-        dup c-type-getter % \ swap , heap-size , \ memcpy ,
+    '[ @ swap @ _ memcpy ] ;
-    ] [ ] make ;

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

@@ -178,6 +178,8 @@ $nl
     { { $snippet "ulonglong" } { } }
     { { $snippet "float" } { } }
     { { $snippet "double" } { "same format as " { $link float } " objects" } }
+    { { $snippet "complex-float" } { "C99 " { $snippet "complex float" } " type, converted to and from " { $link complex } " values" } }
+    { { $snippet "complex-double" } { "C99 " { $snippet "complex double" } " type, converted to and from " { $link complex } " values" } }
 }
 "When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
 $nl

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

@@ -201,13 +201,13 @@ M: byte-array byte-length length ;
     1 swap malloc-array ; inline
 
 : malloc-byte-array ( byte-array -- alien )
-    dup length [ nip malloc dup ] 2keep memcpy ;
+    dup byte-length [ nip malloc dup ] 2keep memcpy ;
 
 : memory>byte-array ( alien len -- byte-array )
     [ nip (byte-array) dup ] 2keep memcpy ;
 
 : byte-array>memory ( byte-array base -- )
-    swap dup length memcpy ;
+    swap dup byte-length memcpy ;
 
 : array-accessor ( type quot -- def )
     [
@@ -263,7 +263,7 @@ M: long-long-type box-return ( type -- )
     ] when ;
 
 : malloc-file-contents ( path -- alien len )
-    binary file-contents dup malloc-byte-array swap length ;
+    binary file-contents [ malloc-byte-array ] [ length ] bi ;
 
 : if-void ( type true false -- )
     pick "void" = [ drop nip call ] [ nip call ] if ; inline
@@ -283,9 +283,10 @@ M: long-long-type box-return ( type -- )
     <c-type>
         c-ptr >>class
         [ alien-cell ] >>getter
-        [ set-alien-cell ] >>setter
+        [ [ >c-ptr ] 2dip set-alien-cell ] >>setter
         bootstrap-cell >>size
         bootstrap-cell >>align
+        [ >c-ptr ] >>unboxer-quot
         "box_alien" >>boxer
         "alien_offset" >>unboxer
     "void*" define-primitive-type

basis/alien/complex/authors.txt

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

basis/alien/complex/complex-tests.factor

@@ -0,0 +1,18 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test alien.complex kernel alien.c-types alien.syntax
+namespaces ;
+IN: alien.complex.tests
+
+C-STRUCT: complex-holder
+    { "complex-float" "z" } ;
+
+: <complex-holder> ( z -- alien )
+    "complex-holder" <c-object>
+    [ set-complex-holder-z ] keep ;
+
+[ ] [
+    C{ 1.0 2.0 } <complex-holder> "h" set
+] unit-test
+
+[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test

basis/alien/complex/complex.factor

@@ -0,0 +1,6 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.complex.functor sequences kernel ;
+IN: alien.complex
+
+<< { "float" "double" } [ dup "complex-" prepend define-complex-type ] each >>

basis/alien/complex/functor/authors.txt

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

basis/alien/complex/functor/functor-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test alien.complex.functor ;
+IN: alien.complex.functor.tests

basis/alien/complex/functor/functor.factor

@@ -0,0 +1,35 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.structs alien.c-types math math.functions sequences
+arrays kernel functors vocabs.parser namespaces accessors
+quotations ;
+IN: alien.complex.functor
+
+FUNCTOR: define-complex-type ( N T -- )
+
+T-real DEFINES ${T}-real
+T-imaginary DEFINES ${T}-imaginary
+set-T-real DEFINES set-${T}-real
+set-T-imaginary DEFINES set-${T}-imaginary
+
+>T DEFINES >${T}
+T> DEFINES ${T}>
+
+WHERE
+
+: >T ( z -- alien )
+    >rect T <c-object> [ set-T-imaginary ] [ set-T-real ] [ ] tri ; inline
+
+: T> ( alien -- z )
+    [ T-real ] [ T-imaginary ] bi rect> ; inline
+
+T in get
+{ { N "real" } { N "imaginary" } }
+define-struct
+
+T c-type
+T> 1quotation >>boxer-quot
+>T 1quotation >>unboxer-quot
+drop
+
+;FUNCTOR

basis/alien/complex/summary.txt

@@ -0,0 +1 @@
+Implementation details for C99 complex float and complex double types

basis/alien/structs/structs.factor

@@ -5,7 +5,7 @@ math namespaces parser sequences strings words libc fry
 alien.c-types alien.structs.fields cpu.architecture math.order ;
 IN: alien.structs
 
-TUPLE: struct-type size align fields ;
+TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
 
 M: struct-type heap-size size>> ;
 
@@ -15,6 +15,10 @@ M: struct-type c-type-align align>> ;
 
 M: struct-type c-type-stack-align? drop f ;
 
+M: struct-type c-type-boxer-quot boxer-quot>> ;
+
+M: struct-type c-type-unboxer-quot unboxer-quot>> ;
+
 : if-value-struct ( ctype true false -- )
     [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
 
@@ -40,7 +44,10 @@ M: struct-type stack-size
 
 : (define-struct) ( name size align fields -- )
     [ [ align ] keep ] dip
-    struct-type boa
+    struct-type new
+    swap >>fields
+    swap >>align
+    swap >>size
     swap typedef ;
 
 : make-fields ( name vocab fields -- fields )

basis/cocoa/messages/messages.factor

@@ -208,7 +208,7 @@ ERROR: no-objc-type name ;
     [ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
     over 0 = [ 3drop ] [
         [ <direct-void*-array> ] dip
-        [ each ] [ drop underlying>> (free) ] 2bi
+        [ each ] [ drop (free) ] 2bi
     ] if ; inline
 
 : register-objc-methods ( class -- )

basis/cocoa/views/views.factor

@@ -72,7 +72,7 @@ PRIVATE>
             NSOpenGLPFASamples , 8 ,
         ] when
         0 ,
-    ] int-array{ } make underlying>>
+    ] int-array{ } make
     -> initWithAttributes:
     -> autorelease ;
 

basis/combinators/smart/smart-tests.factor

@@ -37,3 +37,11 @@ IN: combinators.smart.tests
 [
     [ { 1 } { 2 } { 3 } ] B{ } append-outputs-as
 ] unit-test
+
+! Test nesting
+: nested-smart-combo-test ( -- array )
+    [ [ 1 2 ] output>array [ 3 4 ] output>array ] output>array ;
+
+\ nested-smart-combo-test must-infer
+
+[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test

basis/compiler/codegen/codegen.factor

@@ -3,8 +3,8 @@
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays sets libc continuations.private
+alien.strings alien.arrays alien.complex sets libc
-fry cpu.architecture
+continuations.private fry cpu.architecture
 compiler.errors
 compiler.alien
 compiler.cfg

basis/compiler/tests/alien.factor

@@ -198,8 +198,8 @@ FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ;
 FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
 
 [ 32.0 ] [
-    { 1.0 2.0 3.0 } >float-array underlying>>
+    { 1.0 2.0 3.0 } >float-array
-    { 4.0 5.0 6.0 } >float-array underlying>>
+    { 4.0 5.0 6.0 } >float-array
     ffi_test_23
 ] unit-test
 
@@ -558,3 +558,10 @@ FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
 : stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
 
 [ ] [ stack-frame-bustage 2drop ] unit-test
+
+FUNCTION: complex-float ffi_test_45 ( complex-float x, complex-double y ) ;
+
+[ C{ 4.0 4.0 } ] [
+    C{ 1.0 2.0 }
+    C{ 1.5 1.0 } ffi_test_45
+] unit-test

basis/db/postgresql/lib/lib.factor

@@ -65,7 +65,7 @@ M: postgresql-result-null summary ( obj -- str )
     } case ;
 
 : param-types ( statement -- seq )
-    in-params>> [ type>> type>oid ] uint-array{ } map-as underlying>> ;
+    in-params>> [ type>> type>oid ] uint-array{ } map-as ;
 
 : malloc-byte-array/length ( byte-array -- alien length )
     [ malloc-byte-array &free ] [ length ] bi ;
@@ -91,11 +91,11 @@ M: postgresql-result-null summary ( obj -- str )
     ] 2map flip [
         f f
     ] [
-        first2 [ >void*-array underlying>> ] [ >uint-array underlying>> ] bi*
+        first2 [ >void*-array ] [ >uint-array ] bi*
     ] if-empty ;
 
 : param-formats ( statement -- seq )
-    in-params>> [ type>> type>param-format ] uint-array{ } map-as underlying>> ;
+    in-params>> [ type>> type>param-format ] uint-array{ } map-as ;
 
 : do-postgresql-bound-statement ( statement -- res )
     [

basis/farkup/farkup-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: farkup kernel peg peg.ebnf tools.test namespaces xml
-urls.encoding assocs xml.utilities xml.data ;
+urls.encoding assocs xml.traversal xml.data ;
 IN: farkup.tests
 
 relative-link-prefix off

basis/farkup/farkup.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators io
 io.streams.string kernel math namespaces peg peg.ebnf
-sequences sequences.deep strings xml.entities xml.literals
+sequences sequences.deep strings xml.entities xml.syntax
 vectors splitting xmode.code2html urls.encoding xml.data
 xml.writer ;
 IN: farkup

basis/functors/functors-tests.factor

@@ -1,11 +1,12 @@
 IN: functors.tests
-USING: functors tools.test math words kernel ;
+USING: functors tools.test math words kernel multiline parser
+io.streams.string generic ;
 
 <<
 
 FUNCTOR: define-box ( T -- )
 
-B DEFINES ${T}-box
+B DEFINES-CLASS ${T}-box
 <B> DEFINES <${B}>
 
 WHERE
@@ -62,4 +63,48 @@ WHERE
 
 >>
 
-[ 4 ] [ 1 3 blah ] unit-test
+[ 4 ] [ 1 3 blah ] unit-test
+
+GENERIC: some-generic ( a -- b )
+
+! Does replacing an ordinary word with a functor-generated one work?
+[ [ ] ] [
+    <" IN: functors.tests
+
+    TUPLE: some-tuple ;
+    : some-word ( -- ) ;
+    M: some-tuple some-generic ;
+    "> <string-reader> "functors-test" parse-stream
+] unit-test
+
+: test-redefinition ( -- )
+    [ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test
+    [ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test
+    [ t ] [
+        "some-tuple" "functors.tests" lookup
+        "some-generic" "functors.tests" lookup method >boolean
+    ] unit-test ;
+
+test-redefinition
+
+FUNCTOR: redefine-test ( W -- )
+
+W-word DEFINES ${W}-word
+W-tuple DEFINES-CLASS ${W}-tuple
+W-generic IS ${W}-generic
+
+WHERE
+
+TUPLE: W-tuple ;
+: W-word ( -- ) ;
+M: W-tuple W-generic ;
+
+;FUNCTOR
+
+[ [ ] ] [
+    <" IN: functors.tests
+    << "some" redefine-test >>
+    "> <string-reader> "functors-test" parse-stream
+] unit-test
+
+test-redefinition

basis/functors/functors.factor

@@ -3,8 +3,9 @@
 USING: kernel quotations classes.tuple make combinators generic
 words interpolate namespaces sequences io.streams.string fry
 classes.mixin effects lexer parser classes.tuple.parser
-effects.parser locals.types locals.parser
+effects.parser locals.types locals.parser generic.parser
-locals.rewrite.closures vocabs.parser arrays accessors ;
+locals.rewrite.closures vocabs.parser classes.parser
+arrays accessors ;
 IN: functors
 
 ! This is a hack
@@ -29,7 +30,7 @@ M: object >fake-quotations ;
 GENERIC: fake-quotations> ( fake -- quot )
 
 M: fake-quotation fake-quotations>
-    seq>> [ fake-quotations> ] map >quotation ;
+    seq>> [ fake-quotations> ] [ ] map-as ;
 
 M: array fake-quotations> [ fake-quotations> ] map ;
 
@@ -57,7 +58,7 @@ M: object fake-quotations> ;
     effect off
     scan-param parsed
     scan-param parsed
-    \ create-method parsed
+    \ create-method-in parsed
     parse-definition*
     DEFINE* ; parsing
 
@@ -96,6 +97,8 @@ PRIVATE>
 
 : DEFINES [ create-in ] (INTERPOLATE) ; parsing
 
+: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; parsing
+
 DEFER: ;FUNCTOR delimiter
 
 <PRIVATE

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

@@ -7,8 +7,8 @@ xml
 xml.data
 xml.entities
 xml.writer
-xml.utilities
+xml.traversal
-xml.literals
+xml.syntax
 html.components
 html.elements
 html.forms

basis/help/html/html.factor

@@ -5,7 +5,7 @@ io.files io.files.temp io.directories html.streams help kernel
 assocs sequences make words accessors arrays help.topics vocabs
 tools.vocabs tools.vocabs.browser namespaces prettyprint io
 vocabs.loader serialize fry memoize unicode.case math.order
-sorting debugger html xml.literals xml.writer ;
+sorting debugger html xml.syntax xml.writer ;
 IN: help.html
 
 : escape-char ( ch -- )

basis/html/components/components-docs.factor

@@ -100,6 +100,6 @@ $nl
 { $subsection farkup }
 "Creating custom components:"
 { $subsection render* }
-"Custom components can emit HTML using the " { $vocab-link "xml.literals" } " vocabulary." ;
+"Custom components can emit HTML using the " { $vocab-link "xml.syntax" } " vocabulary." ;
 
 ABOUT: "html.components"

basis/html/components/components.factor

@@ -4,7 +4,7 @@ USING: accessors kernel namespaces io math.parser assocs classes
 classes.tuple words arrays sequences splitting mirrors
 hashtables combinators continuations math strings inspector
 fry locals calendar calendar.format xml.entities xml.data
-validators urls present xml.writer xml.literals xml
+validators urls present xml.writer xml.syntax xml
 xmode.code2html lcs.diff2html farkup io.streams.string
 html html.streams html.forms ;
 IN: html.components

basis/html/elements/elements.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.styles kernel namespaces prettyprint quotations
 sequences strings words xml.entities compiler.units effects
-xml.data xml.literals urls math math.parser combinators
+xml.data urls math math.parser combinators
 present fry io.streams.string xml.writer html ;
 IN: html.elements
 

basis/html/forms/forms.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors strings namespaces assocs hashtables io
 mirrors math fry sequences words continuations
-xml.entities xml.writer xml.literals ;
+xml.entities xml.writer xml.syntax ;
 IN: html.forms
 
 TUPLE: form errors values validation-failed ;

basis/html/html.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel xml.data xml.writer xml.literals urls.encoding ;
+USING: kernel xml.data xml.writer xml.syntax urls.encoding ;
 IN: html
 
 : simple-page ( title head body -- xml )
@@ -21,4 +21,4 @@ IN: html
     [XML <span class="error"><-></span> XML] ;
 
 : simple-link ( xml url -- xml' )
-    url-encode swap [XML <a href=<->><-></a> XML] ;
+    url-encode swap [XML <a href=<->><-></a> XML] ;

basis/html/streams/streams.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel assocs io io.styles math math.order math.parser
-sequences strings make words combinators macros xml.literals html fry
+sequences strings make words combinators macros xml.syntax html fry
 destructors ;
 IN: html.streams
 

basis/html/templates/chloe/chloe.factor

@@ -5,7 +5,7 @@ namespaces make classes.tuple assocs splitting words arrays io
 io.files io.files.info io.encodings.utf8 io.streams.string
 unicode.case mirrors math urls present multiline quotations xml
 logging continuations
-xml.data xml.writer xml.literals strings
+xml.data xml.writer xml.syntax strings
 html.forms
 html
 html.elements

basis/html/templates/chloe/syntax/syntax.factor

@@ -5,7 +5,7 @@ USING: accessors kernel sequences combinators kernel namespaces
 classes.tuple assocs splitting words arrays memoize parser lexer
 io io.files io.encodings.utf8 io.streams.string
 unicode.case mirrors fry math urls
-multiline xml xml.data xml.writer xml.utilities
+multiline xml xml.data xml.writer xml.syntax
 html.components
 html.templates ;
 

basis/html/templates/templates.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel fry io io.encodings.utf8 io.files
 debugger prettyprint continuations namespaces boxes sequences
 arrays strings html io.streams.string
-quotations xml.data xml.writer xml.literals ;
+quotations xml.data xml.writer xml.syntax ;
 IN: html.templates
 
 MIXIN: template

basis/http/http-tests.factor

@@ -299,7 +299,7 @@ test-db [
 [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
 
 USING: html.components html.forms
-xml xml.utilities validators
+xml xml.traversal validators
 furnace furnace.conversations ;
 
 SYMBOL: a

basis/http/server/responses/responses.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math.parser http accessors kernel xml.literals xml.writer
+USING: math.parser http accessors kernel xml.syntax xml.writer
 io io.streams.string io.encodings.utf8 ;
 IN: http.server.responses
 

basis/http/server/static/static.factor

@@ -4,7 +4,7 @@ USING: calendar kernel math math.order math.parser namespaces
 parser sequences strings assocs hashtables debugger mime.types
 sorting logging calendar.format accessors splitting io io.files
 io.files.info io.directories io.pathnames io.encodings.binary
-fry xml.entities destructors urls html xml.literals
+fry xml.entities destructors urls html xml.syntax
 html.templates.fhtml http http.server http.server.responses
 http.server.redirection xml.writer ;
 IN: http.server.static

basis/io/backend/unix/multiplexers/epoll/epoll.factor

@@ -51,7 +51,7 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
     ] [ 2drop f ] if ;
 
 : wait-event ( mx us -- n )
-    [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
+    [ [ fd>> ] [ events>> ] bi dup length ] [ 1000 /i ] bi*
     epoll_wait multiplexer-error ;
 
 : handle-event ( event mx -- )

basis/io/backend/unix/multiplexers/kqueue/kqueue.factor

@@ -59,7 +59,7 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
 : wait-kevent ( mx timespec -- n )
     [
         [ fd>> f 0 ]
-        [ events>> [ underlying>> ] [ length ] bi ] bi
+        [ events>> dup length ] bi
     ] dip kevent multiplexer-error ;
 
 : handle-kevent ( mx kevent -- )

basis/io/backend/unix/multiplexers/select/select.factor

@@ -44,8 +44,8 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 
 : init-fdsets ( mx -- nfds read write except )
     [ num-fds ]
-    [ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ]
+    [ read-fdset/tasks [ init-fdset ] keep ]
-    [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
+    [ write-fdset/tasks [ init-fdset ] keep ] tri
     f ;
 
 M:: select-mx wait-for-events ( us mx -- )

basis/io/launcher/windows/windows.factor

@@ -103,7 +103,7 @@ TUPLE: CreateProcess-args
             over get-environment
             [ swap % "=" % % "\0" % ] assoc-each
             "\0" %
-        ] ushort-array{ } make underlying>>
+        ] ushort-array{ } make
         >>lpEnvironment
     ] when ;
 
@@ -158,7 +158,7 @@ M: windows kill-process* ( handle -- )
 M: windows wait-for-processes ( -- ? )
     processes get keys dup
     [ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
-    [ length ] [ underlying>> ] bi 0 0
+    [ length ] keep 0 0
     WaitForMultipleObjects
     dup HEX: ffffffff = [ win32-error ] when
     dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;

basis/io/pipes/unix/unix.factor

@@ -7,5 +7,5 @@ QUALIFIED: io.pipes
 
 M: unix io.pipes:(pipe) ( -- pair )
     2 <int-array>
-    [ underlying>> pipe io-error ]
+    [ pipe io-error ]
     [ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;

basis/lcs/diff2html/diff2html.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lcs xml.literals xml.writer kernel strings ;
+USING: lcs xml.syntax xml.writer kernel strings ;
 FROM: accessors => item>> ;
 FROM: io => write ;
 FROM: sequences => each if-empty when-empty map ;

basis/libc/libc.factor

@@ -73,12 +73,13 @@ PRIVATE>
     (calloc) check-ptr add-malloc ;
 
 : realloc ( alien size -- newalien )
+    [ >c-ptr ] dip
     over malloc-exists? [ realloc-error ] unless
     [ drop ] [ (realloc) check-ptr ] 2bi
     [ delete-malloc ] [ add-malloc ] bi* ;
 
 : free ( alien -- )
-    [ delete-malloc ] [ (free) ] bi ;
+    >c-ptr [ delete-malloc ] [ (free) ] bi ;
 
 : memcpy ( dst src size -- )
     "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;

basis/math/blas/matrices/matrices.factor

@@ -256,7 +256,7 @@ XGEMM       IS cblas_${T}gemm
 XGERU       IS cblas_${T}ger${U}
 XGERC       IS cblas_${T}ger${C}
 
-MATRIX      DEFINES ${TYPE}-blas-matrix
+MATRIX      DEFINES-CLASS ${TYPE}-blas-matrix
 <MATRIX>    DEFINES <${TYPE}-blas-matrix>
 >MATRIX     DEFINES >${TYPE}-blas-matrix
 XMATRIX{    DEFINES ${T}matrix{

basis/math/blas/vectors/vectors.factor

@@ -134,7 +134,7 @@ XCOPY          IS cblas_${T}copy
 XSWAP          IS cblas_${T}swap
 IXAMAX         IS cblas_i${T}amax
 
-VECTOR         DEFINES ${TYPE}-blas-vector
+VECTOR         DEFINES-CLASS ${TYPE}-blas-vector
 <VECTOR>       DEFINES <${TYPE}-blas-vector>
 >VECTOR        DEFINES >${TYPE}-blas-vector
 

basis/mime/multipart/multipart.factor

@@ -99,7 +99,7 @@ ERROR: end-of-stream multipart ;
     dup name>> empty-name? [
         drop
     ] [
-        [ [ header>> ] [ name>> unquote ] [ name-content>> ] tri mime-variable boa ]
+        [ name-content>> ]
         [ name>> unquote ]
         [ mime-parts>> set-at ] tri
     ] if ;

basis/opengl/opengl.factor

@@ -50,16 +50,16 @@ MACRO: all-enabled-client-state ( seq quot -- )
     glMatrixMode glPopMatrix ; inline
 
 : gl-material ( face pname params -- )
-    float-array{ } like underlying>> glMaterialfv ;
+    float-array{ } like glMaterialfv ;
 
 : gl-vertex-pointer ( seq -- )
-    [ 2 GL_FLOAT 0 ] dip underlying>> glVertexPointer ; inline
+    [ 2 GL_FLOAT 0 ] dip glVertexPointer ; inline
 
 : gl-color-pointer ( seq -- )
-    [ 4 GL_FLOAT 0 ] dip underlying>> glColorPointer ; inline
+    [ 4 GL_FLOAT 0 ] dip glColorPointer ; inline
 
 : gl-texture-coord-pointer ( seq -- )
-    [ 2 GL_FLOAT 0 ] dip underlying>> glTexCoordPointer ; inline
+    [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
 
 : line-vertices ( a b -- )
     [ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
@@ -174,7 +174,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
     glActiveTexture swap glBindTexture gl-error ;
 
 : (set-draw-buffers) ( buffers -- )
-    [ length ] [ >uint-array underlying>> ] bi glDrawBuffers ;
+    [ length ] [ >uint-array ] bi glDrawBuffers ;
 
 MACRO: set-draw-buffers ( buffers -- )
     words>values '[ _ (set-draw-buffers) ] ;

basis/opengl/shaders/shaders.factor

@@ -96,7 +96,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
     dup gl-program-shaders-length
     0 <int>
     over <uint-array>
-    [ underlying>> glGetAttachedShaders ] keep ;
+    [ glGetAttachedShaders ] keep ;
 
 : delete-gl-program-only ( program -- )
     glDeleteProgram ; inline

basis/sequences/next/next-tests.factor

@@ -1,5 +0,0 @@
-USING: sequences.next tools.test arrays kernel math sequences ;
-
-[ { { 1 0 } { 2 1 } { f 2 } } ] [ 3 [ 2array ] map-next ] unit-test
-
-[ 8 ] [ 3 [ 1+ ] map 0 swap [ swap [ + + ] [ drop ] if* ] each-next ] unit-test

basis/sequences/next/next.factor

@@ -1,21 +0,0 @@
-USING: kernel sequences sequences.private math ;
-IN: sequences.next
-
-<PRIVATE
-
-: iterate-seq ( seq quot -- i seq quot )
-    [ [ length ] keep ] dip ; inline
-
-: (map-next) ( i seq quot -- )
-    ! this uses O(n) more bounds checks than is really necessary
-    [ [ [ 1+ ] dip ?nth ] 2keep nth-unsafe ] dip call ; inline
-
-PRIVATE>
-
-: each-next ( seq quot: ( next-elt elt -- ) -- )
-    iterate-seq [ (map-next) ] 2curry each-integer ; inline
-
-: map-next ( seq quot: ( next-elt elt -- newelt ) -- newseq )
-    over dup length swap new-sequence [
-        iterate-seq [ (map-next) ] 2curry
-    ] dip [ collect ] keep ; inline

basis/sequences/next/summary.txt

@@ -1 +0,0 @@
-Iteration with access to next element

basis/sequences/next/tags.txt

@@ -1 +0,0 @@
-collections

basis/specialized-arrays/direct/functor/functor.factor

@@ -11,7 +11,7 @@ A'      IS ${T}-array
 >A'     IS >${T}-array
 <A'>    IS <${A'}>
 
-A       DEFINES direct-${T}-array
+A       DEFINES-CLASS direct-${T}-array
 <A>     DEFINES <${A}>
 
 NTH     [ T dup c-getter array-accessor ]

basis/specialized-arrays/functor/functor.factor

@@ -15,7 +15,7 @@ M: bad-byte-array-length summary
 
 FUNCTOR: define-array ( T -- )
 
-A            DEFINES ${T}-array
+A            DEFINES-CLASS ${T}-array
 <A>          DEFINES <${A}>
 (A)          DEFINES (${A})
 >A           DEFINES >${A}

basis/specialized-arrays/specialized-arrays-tests.factor

@@ -1,7 +1,8 @@
 IN: specialized-arrays.tests
 USING: tools.test specialized-arrays sequences
 specialized-arrays.int specialized-arrays.bool
-specialized-arrays.ushort alien.c-types accessors kernel ;
+specialized-arrays.ushort alien.c-types accessors kernel
+specialized-arrays.direct.int arrays ;
 
 [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
 
@@ -16,3 +17,7 @@ specialized-arrays.ushort alien.c-types accessors kernel ;
 ] unit-test
 
 [ B{ 210 4 1 } byte-array>ushort-array ] must-fail
+
+[ { 3 1 3 3 7 } ] [
+    int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
+] unit-test

basis/specialized-vectors/functor/functor.factor

@@ -9,7 +9,7 @@ FUNCTOR: define-vector ( T -- )
 A   IS      ${T}-array
 <A> IS      <${A}>
 
-V   DEFINES ${T}-vector
+V   DEFINES-CLASS ${T}-vector
 <V> DEFINES <${V}>
 >V  DEFINES >${V}
 V{  DEFINES ${V}{

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

@@ -42,3 +42,18 @@ C: <color> color
 [ bad-new-test ] must-infer
 
 [ bad-new-test ] must-fail
+
+! Corner case if macro expansion calls 'infer', found by Doug
+DEFER: smart-combo ( quot -- )
+
+\ smart-combo [ infer [ ] curry ] 1 define-transform
+
+[ [ "a" "b" "c" ] smart-combo ] must-infer
+
+[ [ [ "a" "b" ] smart-combo "c" ] smart-combo ] must-infer
+
+: very-smart-combo ( quot -- ) smart-combo ; inline
+
+[ [ "a" "b" "c" ] very-smart-combo ] must-infer
+
+[ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer

basis/stack-checker/transforms/transforms.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors arrays kernel words sequences generic math
 namespaces make quotations assocs combinators classes.tuple
 classes.tuple.private effects summary hashtables classes generic
-sets definitions generic.standard slots.private continuations
+sets definitions generic.standard slots.private continuations locals
 stack-checker.backend stack-checker.state stack-checker.visitor
 stack-checker.errors stack-checker.values
 stack-checker.recursive-state ;
@@ -15,48 +15,32 @@ IN: stack-checker.transforms
     [ dup infer-word apply-word/effect ]
     if ;
 
-: ((apply-transform)) ( word quot values stack -- )
+:: ((apply-transform)) ( word quot values stack rstate -- )
-    rot with-datastack first2
+    rstate recursive-state
-    dup [
+    [ stack quot with-datastack first ] with-variable
-        [
+    [
-            [ drop ]
+        word inlined-dependency depends-on
-            [ [ length meta-d shorten-by ] [ #drop, ] bi ] bi*
+        values [ length meta-d shorten-by ] [ #drop, ] bi
-        ] 2dip
+        rstate infer-quot
-        swap infer-quot
+    ] [ word give-up-transform ] if* ;
-    ] [
-        3drop give-up-transform
-    ] if ; inline
 
 : (apply-transform) ( word quot n -- )
     ensure-d dup [ known literal? ] all? [
-        dup empty? [
+        dup empty? [ dup recursive-state get ] [
-            recursive-state get 1array
-        ] [
             [ ]
             [ [ literal value>> ] map ]
             [ first literal recursion>> ] tri
-            prefix
         ] if
         ((apply-transform))
     ] [ 2drop give-up-transform ] if ;
 
 : apply-transform ( word -- )
-    [ inlined-dependency depends-on ] [
+    [ ] [ "transform-quot" word-prop ] [ "transform-n" word-prop ] tri
-        [ ]
+    (apply-transform) ;
-        [ "transform-quot" word-prop ]
-        [ "transform-n" word-prop ]
-        tri
-        (apply-transform)
-    ] bi ;
 
 : apply-macro ( word -- )
-    [ inlined-dependency depends-on ] [
+    [ ] [ "macro" word-prop ] [ "declared-effect" word-prop in>> length ] tri
-        [ ]
+    (apply-transform) ;
-        [ "macro" word-prop ]
-        [ "declared-effect" word-prop in>> length ]
-        tri
-        (apply-transform)
-    ] bi ;
 
 : define-transform ( word quot n -- )
     [ drop "transform-quot" set-word-prop ]

basis/struct-arrays/struct-arrays-tests.factor

@@ -22,7 +22,7 @@ C-STRUCT: test-struct
 [ 5/4 ] [
     [
         2 "test-struct" malloc-struct-array
-        dup underlying>> &free drop
+        dup &free drop
         1 2 make-point over set-first
         3 4 make-point over set-second
         0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce
@@ -34,6 +34,6 @@ C-STRUCT: test-struct
 [ ] [
     [
         10 "test-struct" malloc-struct-array
-        underlying>> &free drop
+        &free drop
     ] with-destructors
 ] unit-test

basis/syndication/syndication.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
 ! Portions copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: xml.utilities kernel assocs math.order
+USING: xml.traversal kernel assocs math.order
     strings sequences xml.data xml.writer
     io.streams.string combinators xml xml.entities.html io.files io
-    http.client namespaces make xml.literals hashtables
+    http.client namespaces make xml.syntax hashtables
     calendar.format accessors continuations urls present ;
 IN: syndication
 

basis/unicode/case/case.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: unicode.data sequences sequences.next namespaces
+USING: unicode.data sequences namespaces
 sbufs make unicode.syntax unicode.normalize math hints
 unicode.categories combinators unicode.syntax assocs
 strings splitting kernel accessors unicode.breaks fry locals ;

basis/unix/utilities/utilities.factor

@@ -16,5 +16,5 @@ IN: unix.utilities
     '[ [ advance ] [ *void* _ alien>string ] bi ]
     [ ] produce nip ;
 
-: strings>alien ( strings encoding -- alien )
+: strings>alien ( strings encoding -- array )
-    '[ _ malloc-string ] void*-array{ } map-as f suffix underlying>> ;
+    '[ _ malloc-string ] void*-array{ } map-as f suffix ;

basis/windows/com/wrapper/wrapper.factor

@@ -132,7 +132,7 @@ unless
     [ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
 
 : (callbacks>vtbl) ( callbacks -- vtbl )
-    [ execute ] void*-array{ } map-as underlying>> malloc-byte-array ;
+    [ execute ] void*-array{ } map-as malloc-byte-array ;
 : (callbacks>vtbls) ( callbacks -- vtbls )
     [ (callbacks>vtbl) ] map ;
 

basis/windows/dinput/constants/constants.factor

@@ -59,7 +59,7 @@ SYMBOLS:
             struct args <DIOBJECTDATAFORMAT>
             i alien set-nth
         ] each-index
-        alien underlying>>
+        alien
     ] ;
 
 : (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )

basis/x11/clipboard/clipboard.factor

@@ -51,7 +51,7 @@ TUPLE: x-clipboard atom contents ;
     "TARGETS" x-atom 32 PropModeReplace
     {
         "UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
-    } [ x-atom ] int-array{ } map-as underlying>>
+    } [ x-atom ] int-array{ } map-as
     4 XChangeProperty drop ;
 
 : set-timestamp-prop ( evt -- )

basis/x11/glx/glx.factor

@@ -93,7 +93,7 @@ FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
         GLX_RGBA ,
         GLX_DEPTH_SIZE , 16 ,
         0 ,
-    ] int-array{ } make underlying>>
+    ] int-array{ } make
     glXChooseVisual
     [ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ;
 

basis/x11/xim/xim.factor

@@ -50,7 +50,7 @@ SYMBOL: keysym
 : lookup-string ( event xic -- string keysym )
     [
         prepare-lookup
-        swap keybuf get underlying>> buf-size keysym get 0 <int>
+        swap keybuf get buf-size keysym get 0 <int>
         XwcLookupString
         finish-lookup
     ] with-scope ;

basis/xml-rpc/xml-rpc.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel xml arrays math generic http.client
 combinators hashtables namespaces io base64 sequences strings
-calendar xml.data xml.writer xml.utilities assocs math.parser
+calendar xml.data xml.writer xml.traversal assocs math.parser
-debugger calendar.format math.order xml.literals xml.dispatch ;
+debugger calendar.format math.order xml.syntax ;
 IN: xml-rpc
 
 ! * Sending RPC requests

basis/xml/data/data-docs.factor

@@ -10,7 +10,7 @@ ARTICLE: "xml.data" "XML data types"
 "Simple words for manipulating names:"
     { $subsection names-match? }
     { $subsection assure-name }
-"For high-level tools for manipulating XML, see " { $vocab-link "xml.utilities" } ;
+"For high-level tools for manipulating XML, see " { $vocab-link "xml.traversal" } ;
 
 ARTICLE: { "xml.data" "classes" } "XML data classes"
     "XML documents and chunks are made of the following classes:"

basis/xml/dispatch/dispatch-docs.factor

@@ -1,25 +0,0 @@
-! Copyright (C) 2005, 2009 Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax ;
-IN: xml.dispatch
-
-ABOUT: "xml.dispatch"
-
-ARTICLE: "xml.dispatch" "Dispatch on XML tag names"
-"The " { $link "xml.dispatch" } " vocabulary defines a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
-{ $subsection POSTPONE: TAGS: }
-"and to define a new 'method' for this word, use"
-{ $subsection POSTPONE: TAG: } ;
-
-HELP: TAGS:
-{ $syntax "TAGS: word" }
-{ $values { "word" "a new word to define" } }
-{ $description "Creates a new word to which dispatches on XML tag names." }
-{ $see-also POSTPONE: TAG: } ;
-
-HELP: TAG:
-{ $syntax "TAG: tag word definition... ;" }
-{ $values { "tag" "an XML tag name" } { "word" "an XML process" } }
-{ $description "Defines a 'method' on a word created with " { $link POSTPONE: TAGS: } ". It determines what such a word should do for an argument that is has the given name." }
-{ $examples { $code "TAGS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
-{ $see-also POSTPONE: TAGS: } ;

basis/xml/dispatch/dispatch-tests.factor

@@ -1,33 +0,0 @@
-! Copyright (C) 2005, 2009 Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: xml io kernel math sequences strings xml.utilities
-tools.test math.parser xml.dispatch ;
-IN: xml.dispatch.tests
-
-TAGS: calculate ( tag -- n )
-
-: calc-2children ( tag -- n n )
-    children-tags first2 [ calculate ] dip calculate ;
-
-TAG: number calculate
-    children>string string>number ;
-TAG: add calculate
-    calc-2children + ;
-TAG: minus calculate
-    calc-2children - ;
-TAG: times calculate
-    calc-2children * ;
-TAG: divide calculate
-    calc-2children / ;
-TAG: neg calculate
-    children-tags first calculate neg ;
-
-: calc-arith ( string -- n )
-    string>xml first-child-tag calculate ;
-
-[ 32 ] [
-    "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
-    calc-arith
-] unit-test
-
-\ calc-arith must-infer

basis/xml/dispatch/dispatch.factor

@@ -1,32 +0,0 @@
-! Copyright (C) 2005, 2009 Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: words assocs kernel accessors parser sequences summary
-lexer splitting fry combinators locals ;
-IN: xml.dispatch
-
-TUPLE: no-tag name word ;
-M: no-tag summary
-    drop "The tag-dispatching word has no method for the given tag name" ;
-
-<PRIVATE
-
-: compile-tags ( word xtable -- quot )
-    >alist swap '[ _ no-tag boa throw ] suffix
-    '[ dup main>> _ case ] ;
-
-PRIVATE>
-
-: define-tags ( word -- )
-    dup dup "xtable" word-prop compile-tags define ;
-
-:: define-tag ( string word quot -- )
-    quot string word "xtable" word-prop set-at
-    word define-tags ;
-
-: TAGS:
-    CREATE
-    [ H{ } clone "xtable" set-word-prop ]
-    [ define-tags ] bi ; parsing
-
-: TAG:
-    scan scan-word parse-definition define-tag ; parsing

basis/xml/literals/authors.txt

@@ -1 +0,0 @@
-Daniel Ehrenberg

basis/xml/literals/literals-docs.factor

@@ -1,60 +0,0 @@
-USING: help.markup help.syntax present multiline xml.data ;
-IN: xml.literals
-
-ABOUT: "xml.literals"
-
-ARTICLE: "xml.literals" "XML literals"
-"The " { $vocab-link "xml.literals" } " vocabulary provides a convenient syntax for generating XML documents and chunks. It defines the following parsing words:"
-{ $subsection POSTPONE: <XML }
-{ $subsection POSTPONE: [XML }
-"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
-{ $subsection { "xml.literals" "interpolation" } } ;
-
-HELP: <XML
-{ $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" }
-{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.literals" "interpolation" } } "." } ;
-
-HELP: [XML
-{ $syntax "[XML foo <x>...</x> bar <y>...</y> baz XML]" }
-{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.literals" "interpolation" } } "." } ;
-
-ARTICLE: { "xml.literals" "interpolation" } "XML interpolation syntax"
-"XML interpolation has two forms for each of the words " { $link POSTPONE: <XML } " and " { $link POSTPONE: [XML } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles."
-$nl
-"These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
-{ $example 
-{" USING: splitting sequences xml.writer xml.literals ;
-"one two three" " " split
-[ [XML <item><-></item> XML] ] map
-<XML <doc><-></doc> XML> pprint-xml"}
-{" <?xml version="1.0" encoding="UTF-8"?>
-<doc>
-  <item>
-    one
-  </item>
-  <item>
-    two
-  </item>
-  <item>
-    three
-  </item>
-</doc>"} }
-"Here is an example of the locals version:"
-{ $example
-{" USING: locals urls xml.literals xml.writer ;
-[let |
-    number [ 3 ]
-    false [ f ]
-    url [ URL" http://factorcode.org/" ]
-    string [ "hello" ]
-    word [ \ drop ] |
-    <XML
-        <x
-            number=<-number->
-            false=<-false->
-            url=<-url->
-            string=<-string->
-            word=<-word-> />
-    XML> pprint-xml ] "}
-{" <?xml version="1.0" encoding="UTF-8"?>
-<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} } ;

basis/xml/literals/summary.txt

@@ -1 +0,0 @@
-Syntax for XML interpolation

basis/xml/literals/tags.txt

@@ -1,2 +0,0 @@
-syntax
-enterprise

basis/xml/syntax/syntax-docs.factor

@@ -0,0 +1,101 @@
+! Copyright (C) 2005, 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax xml.data present multiline ;
+IN: xml.syntax
+
+ABOUT: "xml.syntax"
+
+ARTICLE: "xml.syntax" "Syntax extensions for XML"
+"The " { $link "xml.syntax" } " vocabulary defines a number of new parsing words forXML processing."
+{ $subsection { "xml.syntax" "tags" } }
+{ $subsection { "xml.syntax" "literals" } }
+{ $subsection POSTPONE: XML-NS: } ;
+
+ARTICLE: { "xml.syntax" "tags" } "Dispatch on XML tag names"
+"There is a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
+{ $subsection POSTPONE: TAGS: }
+"and to define a new 'method' for this word, use"
+{ $subsection POSTPONE: TAG: } ;
+
+HELP: TAGS:
+{ $syntax "TAGS: word" }
+{ $values { "word" "a new word to define" } }
+{ $description "Creates a new word to which dispatches on XML tag names." }
+{ $see-also POSTPONE: TAG: } ;
+
+HELP: TAG:
+{ $syntax "TAG: tag word definition... ;" }
+{ $values { "tag" "an XML tag name" } { "word" "an XML process" } }
+{ $description "Defines a 'method' on a word created with " { $link POSTPONE: TAGS: } ". It determines what such a word should do for an argument that is has the given name." }
+{ $examples { $code "TAGS: x ( tag -- )\nTAG: a x drop \"hi\" write ;" } }
+{ $see-also POSTPONE: TAGS: } ;
+
+ARTICLE: { "xml.syntax" "literals" } "XML literals"
+"The following words provide syntax for XML literals:"
+{ $subsection POSTPONE: <XML }
+{ $subsection POSTPONE: [XML }
+"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
+{ $subsection { "xml.syntax" "interpolation" } } ;
+
+HELP: <XML
+{ $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" }
+{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML document (" { $link xml } ") on the stack. It can be used for interpolation as well, if interpolation slots are used. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ;
+
+HELP: [XML
+{ $syntax "[XML foo <x>...</x> bar <y>...</y> baz XML]" }
+{ $description "This gives syntax for literal XML documents. When evaluated, there is an XML chunk (" { $link xml-chunk } ") on the stack. For more information about XML interpolation, see " { $link { "xml.syntax" "interpolation" } } "." } ;
+
+ARTICLE: { "xml.syntax" "interpolation" } "XML interpolation syntax"
+"XML interpolation has two forms for each of the words " { $link POSTPONE: <XML } " and " { $link POSTPONE: [XML } ": a fry-like form and a locals form. To splice locals in, use the syntax " { $snippet "<-variable->" } ". To splice something in from the stack, in the style of " { $vocab-link "fry" } ", use the syntax " { $snippet "<->" } ". An XML interpolation form may only use one of these styles."
+$nl
+"These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
+{ $example 
+{" USING: splitting sequences xml.writer xml.syntax ;
+"one two three" " " split
+[ [XML <item><-></item> XML] ] map
+<XML <doc><-></doc> XML> pprint-xml"}
+{" <?xml version="1.0" encoding="UTF-8"?>
+<doc>
+  <item>
+    one
+  </item>
+  <item>
+    two
+  </item>
+  <item>
+    three
+  </item>
+</doc>"} }
+"Here is an example of the locals version:"
+{ $example
+{" USING: locals urls xml.syntax xml.writer ;
+[let |
+    number [ 3 ]
+    false [ f ]
+    url [ URL" http://factorcode.org/" ]
+    string [ "hello" ]
+    word [ \ drop ] |
+    <XML
+        <x
+            number=<-number->
+            false=<-false->
+            url=<-url->
+            string=<-string->
+            word=<-word-> />
+    XML> pprint-xml ] "}
+{" <?xml version="1.0" encoding="UTF-8"?>
+<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} }
+"XML interpolation can also be used, in conjunction with " { $vocab-link "inverse" } " in pattern matching. For example:"
+{ $example {" USING: sequences xml.syntax inverse ;
+: dispatch ( xml -- string )
+    {
+        { [ [XML <a><-></a> XML] ] [ "a" prepend ] }
+        { [ [XML <b><-></b> XML] ] [ "b" prepend ] }
+        { [ [XML <b val='yes'/> XML] ] [ "yes" ] }
+        { [ [XML <b val=<->/> XML] ] [ "no" prepend ] }
+    } switch ;
+[XML <a>pple</a> XML] dispatch write "} "apple" } ;
+
+HELP: XML-NS:
+{ $syntax "XML-NS: name http://url" }
+{ $description "Defines a new word of the given name which constructs XML names in the namespace of the given URL. The names constructed are memoized." } ;

basis/xml/syntax/syntax-tests.factor

@@ -1,9 +1,45 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
+! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test xml.literals multiline kernel assocs
+USING: xml io kernel math sequences strings xml.traversal
-sequences accessors xml.writer xml.literals.private
+tools.test math.parser xml.syntax xml.data xml.syntax.private
-locals splitting urls xml.data classes ;
+accessors multiline locals inverse xml.writer splitting classes ;
-IN: xml.literals.tests
+IN: xml.syntax.tests
+
+! TAGS test
+
+TAGS: calculate ( tag -- n )
+
+: calc-2children ( tag -- n n )
+    children-tags first2 [ calculate ] dip calculate ;
+
+TAG: number calculate
+    children>string string>number ;
+TAG: add calculate
+    calc-2children + ;
+TAG: minus calculate
+    calc-2children - ;
+TAG: times calculate
+    calc-2children * ;
+TAG: divide calculate
+    calc-2children / ;
+TAG: neg calculate
+    children-tags first calculate neg ;
+
+: calc-arith ( string -- n )
+    string>xml first-child-tag calculate ;
+
+[ 32 ] [
+    "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
+    calc-arith
+] unit-test
+
+\ calc-arith must-infer
+
+XML-NS: foo http://blah.com
+
+[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
+
+! XML literals
 
 [ "a" "c" { "a" "c" f } ] [
     "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
@@ -47,7 +83,7 @@ IN: xml.literals.tests
 
 [ {" <?xml version="1.0" encoding="UTF-8"?>
 <x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} ]
-[ 3 f URL" http://factorcode.org/" "hello" \ drop
+[ 3 f "http://factorcode.org/" "hello" \ drop
   <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
   pprint-xml>string  ] unit-test
 

basis/xml/syntax/syntax.factor

@@ -1,11 +1,42 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
+! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: xml xml.state kernel sequences fry assocs xml.data
+USING: words assocs kernel accessors parser sequences summary
-accessors strings make multiline parser namespaces macros
+lexer splitting combinators locals xml.data memoize sequences.deep
-sequences.deep generalizations words combinators
+xml.data xml.state xml namespaces present arrays generalizations strings
-math present arrays unicode.categories locals.backend
+make math macros multiline inverse combinators.short-circuit 
-quotations ;
+sorting fry unicode.categories ;
-IN: xml.literals
+IN: xml.syntax
+
+<PRIVATE
+
+TUPLE: no-tag name word ;
+M: no-tag summary
+    drop "The tag-dispatching word has no method for the given tag name" ;
+
+: compile-tags ( word xtable -- quot )
+    >alist swap '[ _ no-tag boa throw ] suffix
+    '[ dup main>> _ case ] ;
+
+: define-tags ( word -- )
+    dup dup "xtable" word-prop compile-tags define ;
+
+:: define-tag ( string word quot -- )
+    quot string word "xtable" word-prop set-at
+    word define-tags ;
+
+PRIVATE>
+
+: TAGS:
+    CREATE
+    [ H{ } clone "xtable" set-word-prop ]
+    [ define-tags ] bi ; parsing
+
+: TAG:
+    scan scan-word parse-definition define-tag ; parsing
+
+: XML-NS:
+    CREATE-WORD (( string -- name )) over set-stack-effect
+    scan '[ f swap _ <name> ] define-memoized ; parsing
 
 <PRIVATE
 
@@ -143,8 +174,6 @@ PRIVATE>
 : [XML
     "XML]" [ string>chunk ] parse-def ; parsing
 
-USING: inverse sorting fry combinators.short-circuit ;
-
 : remove-blanks ( seq -- newseq )
     [ { [ string? not ] [ [ blank? ] all? not ] } 1|| ] filter ;
 

basis/xml/tests/encodings.factor

@@ -1,4 +1,4 @@
-USING: xml xml.data xml.utilities tools.test accessors kernel
+USING: xml xml.data xml.traversal tools.test accessors kernel
 io.encodings.8-bit ;
 
 [ "\u000131" ] [ "resource:basis/xml/tests/latin5.xml" file>xml children>string ] unit-test

basis/xml/tests/soap.factor

@@ -1,4 +1,4 @@
-USING: sequences xml kernel arrays xml.utilities io.files tools.test ;
+USING: sequences xml kernel arrays xml.traversal io.files tools.test ;
 IN: xml.tests
 
 : assemble-data ( tag -- 3array )

basis/xml/tests/templating.factor

@@ -1,5 +1,5 @@
 USING: kernel xml sequences assocs tools.test io arrays namespaces fry
-accessors xml.data xml.utilities xml.writer generic sequences.deep multiline ;
+accessors xml.data xml.traversal xml.writer generic sequences.deep multiline ;
 IN: xml.tests
 
 : sub-tag

basis/xml/tests/test.factor

@@ -3,7 +3,7 @@
 IN: xml.tests
 USING: kernel xml tools.test io namespaces make sequences
 xml.errors xml.entities.html parser strings xml.data io.files
-xml.utilities continuations assocs
+xml.traversal continuations assocs
 sequences.deep accessors io.streams.string ;
 
 ! This is insufficient

basis/xml/tests/xmltest.factor

@@ -1,6 +1,6 @@
 USING: accessors assocs combinators continuations fry generalizations
 io.pathnames kernel macros sequences stack-checker tools.test xml
-xml.utilities xml.writer arrays xml.data ; 
+xml.traversal xml.writer arrays xml.data ; 
 IN: xml.tests.suite
 
 TUPLE: xml-test id uri sections description type ;

basis/xml/traversal/summary.txt

@@ -0,0 +1 @@
+Utilities for traversing an XML DOM tree

basis/xml/traversal/traversal-docs.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax xml.data sequences strings ;
-IN: xml.utilities
+IN: xml.traversal
 
-ABOUT: "xml.utilities"
+ABOUT: "xml.traversal"
 
-ARTICLE: "xml.utilities" "Utilities for processing XML"
+ARTICLE: "xml.traversal" "Utilities for traversing XML"
-    "Getting parts of an XML document or tag:"
+    "The " { $vocab-link "xml.traversal" } " vocabulary provides utilities for traversing an XML DOM tree and viewing the contents of a single tag. The following words are defined:"
     $nl
     "Note: the difference between deep-tag-named and tag-named is that the former searches recursively among all children and children of children of the tag, while the latter only looks at the direct children, and is therefore more efficient."
     { $subsection tag-named }

basis/xml/traversal/traversal-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: xml xml.utilities tools.test xml.data sequences ;
+USING: xml xml.traversal tools.test xml.data sequences ;
-IN: xml.utilities.tests
+IN: xml.traversal.tests
 
 [ "bar" ] [ "<foo>bar</foo>" string>xml children>string ] unit-test
 
@@ -9,14 +9,10 @@ IN: xml.utilities.tests
 
 [ "" ] [ "<foo/>" string>xml children>string ] unit-test
 
-XML-NS: foo http://blah.com
-
-[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
-
 [ "blah" ] [ "<foo attr='blah'/>" string>xml-chunk "foo" deep-tag-named "attr" attr ] unit-test
 
 [ { "blah" } ] [ "<foo attr='blah'/>" string>xml-chunk "foo" deep-tags-named [ "attr" attr ] map ] unit-test
 
 [ "blah" ] [ "<foo attr='blah'/>" string>xml "foo" deep-tag-named "attr" attr ] unit-test
 
-[ { "blah" } ] [ "<foo attr='blah'/>" string>xml "foo" deep-tags-named [ "attr" attr ] map ] unit-test
+[ { "blah" } ] [ "<foo attr='blah'/>" string>xml "foo" deep-tags-named [ "attr" attr ] map ] unit-test

basis/xml/traversal/traversal.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel namespaces sequences words io assocs
 quotations strings parser lexer arrays xml.data xml.writer debugger
 splitting vectors sequences.deep combinators fry memoize ;
-IN: xml.utilities
+IN: xml.traversal
 
 : children>string ( tag -- string )
     children>> {
@@ -66,14 +66,3 @@ PRIVATE>
 
 : assert-tag ( name name -- )
     names-match? [ "Unexpected XML tag found" throw ] unless ;
-
-: insert-children ( children tag -- )
-    dup children>> [ push-all ]
-    [ swap V{ } like >>children drop ] if ;
-
-: insert-child ( child tag -- )
-    [ 1vector ] dip insert-children ;
-
-: XML-NS:
-    CREATE-WORD (( string -- name )) over set-stack-effect
-    scan '[ f swap _ <name> ] define-memoized ; parsing

basis/xml/utilities/authors.txt

@@ -1 +0,0 @@
-Daniel Ehrenberg

basis/xml/utilities/summary.txt

@@ -1 +0,0 @@
-Utilities for manipulating an XML DOM tree

basis/xml/writer/writer-docs.factor

@@ -41,7 +41,7 @@ HELP: pprint-xml
 
 HELP: indenter
 { $var-description "Contains the string which is used for indenting in the XML prettyprinter. For example, to print an XML document using " { $snippet "%%%%" } " for indentation, you can use the following:" }
-{ $example {" USING: xml.literals xml.writer namespaces ;
+{ $example {" USING: xml.syntax xml.writer namespaces ;
 [XML <foo>bar</foo> XML] "%%%%" indenter [ pprint-xml ] with-variable "} {"
 <foo>
 %%%%bar
@@ -49,7 +49,7 @@ HELP: indenter
 
 HELP: sensitive-tags
 { $var-description "Contains a sequence of " { $link name } "s where whitespace should be considered significant for prettyprinting purposes. The sequence can contain " { $link string } "s in place of names. For example, to preserve whitespace inside a " { $snippet "pre" } " tag:" }
-{ $example {" USING: xml.literals xml.writer namespaces ;
+{ $example {" USING: xml.syntax xml.writer namespaces ;
 [XML <html> <head>   <title> something</title></head><body><pre>bing
 bang
    bong</pre></body></html> XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable "} {"

basis/xml/writer/writer-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: xml.data xml.writer tools.test fry xml kernel multiline
-xml.writer.private io.streams.string xml.utilities sequences
+xml.writer.private io.streams.string xml.traversal sequences
 io.encodings.utf8 io.files accessors io.directories ;
 IN: xml.writer.tests
 

basis/xml/xml-docs.factor

@@ -93,7 +93,7 @@ ARTICLE: "xml" "XML parser"
     { $vocab-subsection "XML parsing errors" "xml.errors" }
     { $vocab-subsection "XML entities" "xml.entities" }
     { $vocab-subsection "XML data types" "xml.data" }
-    { $vocab-subsection "Utilities for processing XML" "xml.utilities" }
+    { $vocab-subsection "Utilities for traversing XML" "xml.traversal" }
-    { $vocab-subsection "Dispatch on XML tag names" "xml.dispatch" } ;
+    { $vocab-subsection "Syntax extensions for XML" "xml.syntax" } ;
 
 ABOUT: "xml"

basis/xmode/code2html/code2html.factor

@@ -1,6 +1,6 @@
 USING: xmode.tokens xmode.marker xmode.catalog kernel locals
 io io.files sequences words io.encodings.utf8
-namespaces xml.entities accessors xml.literals locals xml.writer ;
+namespaces xml.entities accessors xml.syntax locals xml.writer ;
 IN: xmode.code2html
 
 : htmlize-tokens ( tokens -- xml )

basis/xmode/loader/loader.factor

@@ -1,5 +1,5 @@
 USING: xmode.loader.syntax xmode.tokens xmode.rules
-xmode.keyword-map xml.data xml.utilities xml assocs kernel
+xmode.keyword-map xml.data xml.traversal xml assocs kernel
 combinators sequences math.parser namespaces parser
 xmode.utilities parser-combinators.regexp io.files accessors ;
 IN: xmode.loader

basis/xmode/loader/syntax/syntax.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors xmode.tokens xmode.rules xmode.keyword-map
-xml.data xml.utilities xml assocs kernel combinators sequences
+xml.data xml.traversal xml assocs kernel combinators sequences
 math.parser namespaces make parser lexer xmode.utilities
 parser-combinators.regexp io.files splitting arrays ;
 IN: xmode.loader.syntax