From b87b9af4585aaeb12682bbeccf8eee52e61bc2ea Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 23 Jan 2009 15:29:28 -0600 Subject: [PATCH 01/15] DTDs are a separate type now; all variables in xml.state --- basis/xml/autoencoding/autoencoding.factor | 8 ++-- basis/xml/data/data-docs.factor | 49 ++++++++++++++++++++ basis/xml/data/data.factor | 20 +++++++-- basis/xml/dtd/dtd.factor | 28 +----------- basis/xml/elements/elements.factor | 52 +++++++++++----------- basis/xml/entities/entities.factor | 4 +- basis/xml/entities/html/html.factor | 4 +- basis/xml/name/name.factor | 20 ++++++++- basis/xml/state/state.factor | 8 ++++ basis/xml/tests/test.factor | 8 ++-- basis/xml/tests/xmode-dtd.factor | 6 +-- basis/xml/tokenize/tokenize.factor | 12 +---- basis/xml/writer/writer.factor | 4 +- basis/xml/xml.factor | 14 ++---- 14 files changed, 142 insertions(+), 95 deletions(-) diff --git a/basis/xml/autoencoding/autoencoding.factor b/basis/xml/autoencoding/autoencoding.factor index 5d7e460862..5dc32958d4 100644 --- a/basis/xml/autoencoding/autoencoding.factor +++ b/basis/xml/autoencoding/autoencoding.factor @@ -10,8 +10,8 @@ IN: xml.autoencoding : start-utf16le ( -- tag ) utf16le decode-input-if - CHAR: ? expect - 0 expect check instruct ; + "?\0" expect + check instruct ; : 10xxxxxx? ( ch -- ? ) -6 shift 3 bitand 2 = ; @@ -36,10 +36,10 @@ IN: xml.autoencoding : skip-utf8-bom ( -- tag ) "\u0000bb\u0000bf" expect utf8 decode-input - CHAR: < expect check make-tag ; + "<" expect check make-tag ; : decode-expecting ( encoding string -- tag ) - [ decode-input-if next ] [ expect-string ] bi* check make-tag ; + [ decode-input-if next ] [ expect ] bi* check make-tag ; : start-utf16be ( -- tag ) utf16be "<" decode-expecting ; diff --git a/basis/xml/data/data-docs.factor b/basis/xml/data/data-docs.factor index c5f4f6d670..9a8c535f91 100644 --- a/basis/xml/data/data-docs.factor +++ b/basis/xml/data/data-docs.factor @@ -150,3 +150,52 @@ HELP: assure-name HELP: { $values { "string" string } { "name" name } } { $description "Converts a string into an XML name with an empty prefix and URL." } ; + +HELP: element-decl +{ $class-description "Describes the class of element declarations, like ." } ; + +HELP: +{ $values { "name" name } { "content-spec" string } { "element-decl" entity-decl } } +{ $description "Creates an element declaration object, of the class " { $link element-decl } } ; + +HELP: attlist-decl +{ $class-description "Describes the class of element declarations, like ." } ; + +HELP: +{ $values { "name" name } { "att-defs" string } { "attlist-decl" attlist-decl } } +{ $description "Creates an element declaration object, of the class " { $link attlist-decl } } ; + +HELP: entity-decl +{ $class-description "Describes the class of element declarations, like ." } ; + +HELP: +{ $values { "name" name } { "def" string } { "pe?" "t or f" } { "entity-decl" entity-decl } } +{ $description "Creates an entity declaration object, of the class " { $link entity-decl } ". The pe? slot should be t if the object is a DTD-internal entity, like and f if the object is like , that is, it can be used outside of the DTD." } ; + +HELP: system-id +{ $class-description "Describes the class of system identifiers within an XML DTD directive, such as " } ; + +HELP: +{ $values { "system-literal" string } { "system-id" system-id } } +{ $description "Constructs a " { $link system-id } " tuple." } ; + +HELP: public-id +{ $class-description "Describes the class of public identifiers within an XML DTD directive, such as " } ; + +HELP: +{ $values { "pubid-literal" string } { "system-literal" string } { "public-id" public-id } } +{ $description "Constructs a " { $link system-id } " tuple." } ; + +HELP: notation-decl +{ $class-description "Describes the class of element declarations, like ." } ; + +HELP: +{ $values { "name" string } { "id" id } { "notation-decl" notation-decl } } +{ $description "Creates an notation declaration object, of the class " { $link notation-decl } "." } ; + +HELP: doctype-decl +{ $class-description "Describes the class of doctype declarations." } ; + +HELP: +{ $values { "name" name } { "external-id" id } { "internal-subset" sequence } { "doctype-decl" doctype-decl } } +{ $description "Creates a new doctype declaration object, of the class " { $link doctype-decl } ". Only one of external-id or internal-subset will be non-null." } ; diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor index 8c024d938e..4d3391cd46 100644 --- a/basis/xml/data/data.factor +++ b/basis/xml/data/data.factor @@ -84,11 +84,13 @@ C: comment TUPLE: directive ; TUPLE: element-decl < directive - { name string } { content-spec string } ; + { name string } + { content-spec string } ; C: element-decl TUPLE: attlist-decl < directive - { name string } { att-defs string } ; + { name string } + { att-defs string } ; C: attlist-decl UNION: boolean t POSTPONE: f ; @@ -107,13 +109,23 @@ C: public-id UNION: id system-id public-id POSTPONE: f ; +TUPLE: dtd + { directives sequence } + { entities assoc } + { parameter-entities assoc } ; +C: dtd + +UNION: dtd/f dtd POSTPONE: f ; + TUPLE: doctype-decl < directive { name string } { external-id id } - { internal-subset sequence } ; + { internal-subset dtd/f } ; C: doctype-decl -TUPLE: notation-decl < directive name id ; +TUPLE: notation-decl < directive + { name string } + { id string } ; C: notation-decl TUPLE: instruction { text string } ; diff --git a/basis/xml/dtd/dtd.factor b/basis/xml/dtd/dtd.factor index a668717626..50de78ec11 100644 --- a/basis/xml/dtd/dtd.factor +++ b/basis/xml/dtd/dtd.factor @@ -2,12 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: xml.tokenize xml.data xml.state kernel sequences ascii fry xml.errors combinators hashtables namespaces xml.entities -strings ; +strings xml.name ; IN: xml.dtd -: take-word ( -- string ) - [ get-char blank? ] take-until ; - : take-decl-contents ( -- first second ) pass-blank take-word pass-blank ">" take-string ; @@ -20,36 +17,15 @@ IN: xml.dtd : take-notation-decl ( -- notation-decl ) take-decl-contents ; -: take-until-one-of ( seps -- str sep ) - '[ get-char _ member? ] take-until get-char ; - -: take-system-id ( -- system-id ) - parse-quote close ; - -: take-public-id ( -- public-id ) - parse-quote parse-quote close ; - UNION: dtd-acceptable directive comment instruction ; -: (take-external-id) ( token -- external-id ) - pass-blank { - { "SYSTEM" [ take-system-id ] } - { "PUBLIC" [ take-public-id ] } - [ bad-external-id ] - } case ; - -: take-external-id ( -- external-id ) - take-word (take-external-id) ; - -: only-blanks ( str -- ) - [ blank? ] all? [ bad-decl ] unless ; : take-entity-def ( var -- entity-name entity-def ) [ take-word pass-blank get-char { { CHAR: ' [ parse-quote ] } { CHAR: " [ parse-quote ] } - [ drop take-external-id ] + [ drop take-external-id close ] } case ] dip '[ swap _ [ ?set-at ] change ] 2keep ; diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index 947c11e2a8..24de03ac43 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -3,11 +3,11 @@ USING: kernel namespaces xml.tokenize xml.state xml.name xml.data accessors arrays make xml.char-classes fry assocs sequences math xml.errors sets combinators io.encodings io.encodings.iana -unicode.case xml.dtd strings ; +unicode.case xml.dtd strings xml.entities ; IN: xml.elements : parse-attr ( -- ) - parse-name pass-blank CHAR: = expect pass-blank + parse-name pass-blank "=" expect pass-blank t parse-quote* 2array , ; : start-tag ( -- name ? ) @@ -31,14 +31,14 @@ IN: xml.elements : end-tag ( name attrs-alist -- tag ) tag-ns pass-blank get-char CHAR: / = - [ pop-ns next CHAR: > expect ] + [ pop-ns next ">" expect ] [ depth inc close ] if ; : take-comment ( -- comment ) - "--" expect-string + "--" expect "--" take-string - CHAR: > expect ; + ">" expect ; : assure-no-extra ( seq -- ) [ first ] map { @@ -80,7 +80,7 @@ SYMBOL: string-input? string-input? get [ drop ] [ decode-input ] if ; : parse-prolog ( -- prolog ) - pass-blank middle-tag "?>" expect-string + pass-blank middle-tag "?>" expect dup assure-no-extra prolog-attrs dup encoding>> dup "UTF-16" = [ drop ] [ name>encoding [ decode-input-if ] when* ] if @@ -96,45 +96,45 @@ SYMBOL: string-input? : take-cdata ( -- string ) depth get zero? [ bad-cdata ] when - "[CDATA[" expect-string "]]>" take-string ; + "[CDATA[" expect "]]>" take-string ; DEFER: make-tag ! Is this unavoidable? : expand-pe ( -- ) ; ! Make this run the contents of the pe within a DOCTYPE -: (take-internal-subset) ( -- ) +: dtd-loop ( -- ) pass-blank get-char { { CHAR: ] [ next ] } { CHAR: % [ expand-pe ] } { CHAR: < [ next make-tag dup dtd-acceptable? - [ bad-doctype ] unless , (take-internal-subset) + [ bad-doctype ] unless , dtd-loop ] } + { f [ ] } [ 1string bad-doctype ] } case ; -: take-internal-subset ( -- seq ) +: take-internal-subset ( -- dtd ) [ - H{ } pe-table set + H{ } clone pe-table set t in-dtd? set - (take-internal-subset) - ] { } make ; + dtd-loop + pe-table get + ] { } make swap extra-entities get swap ; -: nontrivial-doctype ( -- external-id internal-subset ) - pass-blank get-char CHAR: [ = [ - next take-internal-subset f swap close - ] [ - " >" take-until-one-of { - { CHAR: \s [ (take-external-id) ] } - { CHAR: > [ only-blanks f ] } - } case f - ] if ; +: take-optional-id ( -- id/f ) + get-char "SP" member? + [ take-external-id ] [ f ] if ; + +: take-internal ( -- dtd/f ) + get-char CHAR: [ = + [ next take-internal-subset ] [ f ] if ; : take-doctype-decl ( -- doctype-decl ) - pass-blank " >" take-until-one-of { - { CHAR: \s [ nontrivial-doctype ] } - { CHAR: > [ f f ] } - } case ; + pass-blank take-name + pass-blank take-optional-id + pass-blank take-internal + close ; : take-directive ( -- doctype ) take-name dup "DOCTYPE" = diff --git a/basis/xml/entities/entities.factor b/basis/xml/entities/entities.factor index a3812c7723..a730474f20 100644 --- a/basis/xml/entities/entities.factor +++ b/basis/xml/entities/entities.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: namespaces make kernel assocs sequences fry values -io.files io.encodings.binary ; +io.files io.encodings.binary xml.state ; IN: xml.entities : entities-out @@ -37,7 +37,5 @@ IN: xml.entities { "quot" CHAR: " } } ; -SYMBOL: extra-entities - : with-entities ( entities quot -- ) [ swap extra-entities set call ] with-scope ; inline diff --git a/basis/xml/entities/html/html.factor b/basis/xml/entities/html/html.factor index 826dccf79d..f1e52319f1 100644 --- a/basis/xml/entities/html/html.factor +++ b/basis/xml/entities/html/html.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: assocs io.encodings.binary io.files kernel namespaces sequences -values xml xml.entities ; +values xml xml.entities accessors xml.state ; IN: xml.entities.html VALUE: html-entities : read-entities-file ( file -- table ) - file>dtd nip ; + file>dtd entities>> ; : get-html ( -- table ) { "lat1" "special" "symbol" } [ diff --git a/basis/xml/name/name.factor b/basis/xml/name/name.factor index 32053b1eb4..83132d4d29 100644 --- a/basis/xml/name/name.factor +++ b/basis/xml/name/name.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces accessors xml.tokenize xml.data assocs xml.errors xml.char-classes combinators.short-circuit splitting -fry xml.state sequences ; +fry xml.state sequences combinators ascii ; IN: xml.name ! XML namespace processing: ns = namespace @@ -74,3 +74,21 @@ SYMBOL: ns-stack : parse-name-starting ( string -- name ) take-name append interpret-name ; +: take-system-id ( -- system-id ) + parse-quote ; + +: take-public-id ( -- public-id ) + parse-quote parse-quote ; + +: (take-external-id) ( token -- external-id ) + pass-blank { + { "SYSTEM" [ take-system-id ] } + { "PUBLIC" [ take-public-id ] } + [ bad-external-id ] + } case ; + +: take-word ( -- string ) + [ get-char blank? ] take-until ; + +: take-external-id ( -- external-id ) + take-word (take-external-id) ; diff --git a/basis/xml/state/state.factor b/basis/xml/state/state.factor index b00d723a1a..059d8267a0 100644 --- a/basis/xml/state/state.factor +++ b/basis/xml/state/state.factor @@ -23,3 +23,11 @@ SYMBOL: xml-stack SYMBOL: prolog-data SYMBOL: depth + +SYMBOL: interpolating? + +SYMBOL: in-dtd? + +SYMBOL: pe-table + +SYMBOL: extra-entities diff --git a/basis/xml/tests/test.factor b/basis/xml/tests/test.factor index 794796339e..488bd911bd 100644 --- a/basis/xml/tests/test.factor +++ b/basis/xml/tests/test.factor @@ -49,10 +49,10 @@ SYMBOL: xml-file [ "foo" ] [ "" string>xml children>string ] unit-test [ "" string>xml ] must-fail [ ] [ "" string>xml drop ] unit-test -[ T{ element-decl f "br" "EMPTY" } ] [ "" string>dtd drop second ] unit-test -[ T{ element-decl f "p" "(#PCDATA|emph)*" } ] [ "" string>dtd drop second ] unit-test -[ T{ element-decl f "%name.para;" "%content.para;" } ] [ "" string>dtd drop second ] unit-test -[ T{ element-decl f "container" "ANY" } ] [ "" string>dtd drop second ] unit-test +[ T{ element-decl f "br" "EMPTY" } ] [ "" string>dtd directives>> first ] unit-test +[ T{ element-decl f "p" "(#PCDATA|emph)*" } ] [ "" string>dtd directives>> first ] unit-test +[ T{ element-decl f "%name.para;" "%content.para;" } ] [ "" string>dtd directives>> first ] unit-test +[ T{ element-decl f "container" "ANY" } ] [ "" string>dtd directives>> first ] unit-test [ T{ doctype-decl f "foo" } ] [ "" string>xml-chunk first ] unit-test [ T{ doctype-decl f "foo" } ] [ "" string>xml-chunk first ] unit-test [ T{ doctype-decl f "foo" T{ system-id f "blah.dtd" } } ] [ "" string>xml-chunk first ] unit-test diff --git a/basis/xml/tests/xmode-dtd.factor b/basis/xml/tests/xmode-dtd.factor index 85e3516444..4408655d9c 100644 --- a/basis/xml/tests/xmode-dtd.factor +++ b/basis/xml/tests/xmode-dtd.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: xml io.encodings.utf8 io.files kernel tools.test ; +USING: xml xml.data kernel tools.test ; IN: xml.tests -[ ] [ - "resource:basis/xmode/xmode.dtd" file>dtd 2drop +[ t ] [ + "resource:basis/xmode/xmode.dtd" file>dtd dtd? ] unit-test diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor index 943f4e7a15..774a401fc1 100644 --- a/basis/xml/tokenize/tokenize.factor +++ b/basis/xml/tokenize/tokenize.factor @@ -75,12 +75,7 @@ IN: xml.tokenize dup length rot length 1- - head get-char [ missing-close ] unless next ; -: expect ( ch -- ) - get-char 2dup = [ 2drop ] [ - [ 1string ] bi@ expected - ] if next ; - -: expect-string ( string -- ) +: expect ( string -- ) dup [ get-char next ] replicate 2dup = [ 2drop ] [ expected ] if ; @@ -96,9 +91,6 @@ IN: xml.tokenize "x" ?head 16 10 ? base> , ] [ parse-named-entity ] if ; -SYMBOL: pe-table -SYMBOL: in-dtd? - : parse-pe ( -- ) next CHAR: ; take-char dup next pe-table get at [ % ] [ no-entity ] ?if ; @@ -131,7 +123,7 @@ SYMBOL: in-dtd? ] parse-char ; : close ( -- ) - pass-blank CHAR: > expect ; + pass-blank ">" expect ; : normalize-quote ( str -- str ) [ dup "\t\r\n" member? [ drop CHAR: \s ] when ] map ; diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor index d8283963f1..8cb32af12f 100644 --- a/basis/xml/writer/writer.factor +++ b/basis/xml/writer/writer.factor @@ -136,10 +136,10 @@ M: public-id write-xml-chunk [ pubid-literal>> write "' '" write ] [ system-literal>> write "'" write ] bi ; -: write-internal-subset ( seq -- ) +: write-internal-subset ( dtd -- ) [ "[" write indent - [ ?indent write-xml-chunk ] each + directives>> [ ?indent write-xml-chunk ] each unindent ?indent "]" write ] when* ; diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor index 4dd872156e..fdabbdc4df 100644 --- a/basis/xml/xml.factor +++ b/basis/xml/xml.factor @@ -164,21 +164,15 @@ TUPLE: pull-xml scope ; : file>xml ( filename -- xml ) binary read-xml ; -: (read-dtd) ( -- dtd ) - ! should filter out blanks, throw error on non-dtd stuff - V{ } clone dup [ push ] curry sax-loop ; - -: read-dtd ( stream -- dtd entities ) +: read-dtd ( stream -- dtd ) [ - t in-dtd? set reset-prolog H{ } clone extra-entities set - (read-dtd) - extra-entities get + take-internal-subset ] with-state ; -: file>dtd ( filename -- dtd entities ) +: file>dtd ( filename -- dtd ) utf8 read-dtd ; -: string>dtd ( string -- dtd entities ) +: string>dtd ( string -- dtd ) read-dtd ; From 39e49c3554ed1e69512e1640f423631ba0f43986 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 25 Jan 2009 21:06:45 -0600 Subject: [PATCH 02/15] XML interpolation --- basis/xml/data/data.factor | 3 + basis/xml/elements/elements.factor | 30 ++++++-- .../xml/interpolate/interpolate-tests.factor | 27 ++++++- basis/xml/interpolate/interpolate.factor | 76 ++++++++++++++++++- basis/xml/tests/state-parser-tests.factor | 3 + basis/xml/tokenize/tokenize.factor | 16 ++-- 6 files changed, 141 insertions(+), 14 deletions(-) diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor index 4d3391cd46..d38f589228 100644 --- a/basis/xml/data/data.factor +++ b/basis/xml/data/data.factor @@ -5,6 +5,9 @@ delegate.protocols delegate vectors accessors multiline macros words quotations combinators slots fry strings ; IN: xml.data +TUPLE: interpolated var ; +C: interpolated + UNION: nullable-string string POSTPONE: f ; TUPLE: name diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index 24de03ac43..40ca0fd32e 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -6,9 +6,21 @@ math xml.errors sets combinators io.encodings io.encodings.iana unicode.case xml.dtd strings xml.entities ; IN: xml.elements +: take-interpolated ( quot -- interpolated ) + interpolating? get [ + drop pass-blank + " \t\r\n-" take-to + pass-blank "->" expect + ] [ call ] if ; inline + +: interpolate-quote ( -- interpolated ) + [ quoteless-attr ] take-interpolated ; + : parse-attr ( -- ) parse-name pass-blank "=" expect pass-blank - t parse-quote* 2array , ; + get-char CHAR: < = + [ "<-" expect interpolate-quote ] + [ t parse-quote* ] if 2array , ; : start-tag ( -- name ? ) #! Outputs the name and whether this is a closing tag @@ -151,12 +163,18 @@ DEFER: make-tag ! Is this unavoidable? [ drop take-directive ] } case ; +: normal-tag ( -- tag ) + start-tag + [ dup add-ns pop-ns depth dec close ] + [ middle-tag end-tag ] if ; + +: interpolate-tag ( -- interpolated ) + [ "-" bad-name ] take-interpolated ; + : make-tag ( -- tag ) { { [ get-char dup CHAR: ! = ] [ drop next direct ] } - { [ CHAR: ? = ] [ next instruct ] } - [ - start-tag [ dup add-ns pop-ns depth dec close ] - [ middle-tag end-tag ] if - ] + { [ dup CHAR: ? = ] [ drop next instruct ] } + { [ dup CHAR: - = ] [ drop next interpolate-tag ] } + [ drop normal-tag ] } cond ; diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor index 0adcb51123..6db97268b9 100644 --- a/basis/xml/interpolate/interpolate-tests.factor +++ b/basis/xml/interpolate/interpolate-tests.factor @@ -1,4 +1,29 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test xml.interpolate ; +USING: tools.test xml.interpolate multiline kernel assocs +sequences accessors xml.writer xml.interpolate.private +locals ; IN: xml.interpolate.tests + +[ "a" "c" { "a" "c" } ] [ + "<-a->/>" + interpolated-doc + [ second var>> ] + [ fourth "val" swap at var>> ] + [ extract-variables ] tri +] unit-test + +[ {" + + one + + y + +"} ] [ + [let* | a [ "one" ] c [ "two" ] x [ "y" ] + d [ [XML <-x-> XML] ] | + <-a-> /> <-d-> + XML> pprint-xml>string + ] +] unit-test diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor index 262d0e1adc..cc5233f829 100644 --- a/basis/xml/interpolate/interpolate.factor +++ b/basis/xml/interpolate/interpolate.factor @@ -1,4 +1,78 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: ; +USING: xml xml.state kernel sequences fry assocs xml.data +accessors strings make multiline parser namespaces macros +sequences.deep ; IN: xml.interpolate + +xml-chunk ] with-variable ; + +: interpolated-doc ( string -- xml ) + t interpolating? [ string>xml ] with-variable ; + +DEFER: interpolate-sequence + +: interpolate-attrs ( table attrs -- attrs ) + swap '[ dup interpolated? [ var>> _ at ] when ] assoc-map ; + +: interpolate-tag ( table tag -- tag ) + [ nip name>> ] + [ attrs>> interpolate-attrs ] + [ children>> [ interpolate-sequence ] [ drop f ] if* ] 2tri + ; + +GENERIC: push-item ( item -- ) +M: string push-item , ; +M: object push-item , ; +M: sequence push-item % ; + +GENERIC: interpolate-item ( table item -- ) +M: object interpolate-item nip , ; +M: tag interpolate-item interpolate-tag , ; +M: interpolated interpolate-item + var>> swap at push-item ; + +: interpolate-sequence ( table seq -- seq ) + [ [ interpolate-item ] with each ] { } make ; + +: interpolate-xml-doc ( table xml -- xml ) + (clone) [ interpolate-tag ] change-body ; + +MACRO: interpolate-xml ( string -- doc ) + interpolated-doc '[ _ interpolate-xml-doc ] ; + +MACRO: interpolate-chunk ( string -- chunk ) + interpolated-chunk '[ _ interpolate-sequence ] ; + +: >search-hash ( seq -- hash ) + [ dup search ] H{ } map>assoc ; + +GENERIC: extract-item ( item -- ) +M: interpolated extract-item var>> , ; +M: tag extract-item + attrs>> values + [ interpolated? ] filter + [ var>> , ] each ; +M: object extract-item drop ; + +: extract-variables ( xml -- seq ) + [ [ extract-item ] deep-each ] { } make ; + +: parse-def ( accum delimiter word -- accum ) + [ + parse-multiline-string [ + interpolated-chunk extract-variables + >search-hash parsed + ] keep parsed + ] dip parsed ; + +PRIVATE> + +: " \ interpolate-xml parse-def ; parsing + +: [XML + "XML]" \ interpolate-chunk parse-def ; parsing diff --git a/basis/xml/tests/state-parser-tests.factor b/basis/xml/tests/state-parser-tests.factor index 31d4a03c7b..24c3bc4b69 100644 --- a/basis/xml/tests/state-parser-tests.factor +++ b/basis/xml/tests/state-parser-tests.factor @@ -7,6 +7,9 @@ IN: xml.test.state : take-rest ( -- string ) [ f ] take-until ; +: take-char ( char -- string ) + 1string take-to ; + [ "hello" ] [ "hello" [ take-rest ] string-parse ] unit-test [ 2 4 ] [ "12\n123" [ take-rest drop get-line get-column ] string-parse ] unit-test [ "hi" " how are you?" ] [ "hi how are you?" [ [ get-char blank? ] take-until take-rest ] string-parse ] unit-test diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor index 774a401fc1..b629d46455 100644 --- a/basis/xml/tokenize/tokenize.factor +++ b/basis/xml/tokenize/tokenize.factor @@ -58,8 +58,8 @@ IN: xml.tokenize '[ @ [ t ] [ get-char _ push f ] if ] skip-until ] keep >string ; inline -: take-char ( ch -- string ) - [ dup get-char = ] take-until nip ; +: take-to ( seq -- string ) + '[ get-char _ member? ] take-until ; : pass-blank ( -- ) #! Advance code past any whitespace, including newlines @@ -79,21 +79,25 @@ IN: xml.tokenize dup [ get-char next ] replicate 2dup = [ 2drop ] [ expected ] if ; +! Suddenly XML-specific + : parse-named-entity ( string -- ) dup entities at [ , ] [ dup extra-entities get at [ % ] [ no-entity ] ?if ] ?if ; +: take-; ( -- string ) + next ";" take-to next ; + : parse-entity ( -- ) - next CHAR: ; take-char next - "#" ?head [ + take-; "#" ?head [ "x" ?head 16 10 ? base> , ] [ parse-named-entity ] if ; : parse-pe ( -- ) - next CHAR: ; take-char dup next - pe-table get at [ % ] [ no-entity ] ?if ; + take-; dup pe-table get at + [ % ] [ no-entity ] ?if ; :: (parse-char) ( quot: ( ch -- ? ) -- ) get-char :> char From 4d547653b52d957ce1f9232f962373959d596d01 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:03:36 -0600 Subject: [PATCH 03/15] Clean up basis/ascii/ and update docs --- basis/ascii/ascii-docs.factor | 11 +++++---- basis/ascii/ascii.factor | 44 +++++++++++------------------------ 2 files changed, 19 insertions(+), 36 deletions(-) diff --git a/basis/ascii/ascii-docs.factor b/basis/ascii/ascii-docs.factor index 4c783e609c..b2bbc16836 100644 --- a/basis/ascii/ascii-docs.factor +++ b/basis/ascii/ascii-docs.factor @@ -57,8 +57,10 @@ HELP: >upper { $values { "str" "a string" } { "upper" "a string" } } { $description "Converts an ASCII string to upper case." } ; -ARTICLE: "ascii" "ASCII character classes" -"The " { $vocab-link "ascii" } " vocabulary implements traditional ASCII character classes:" +ARTICLE: "ascii" "ASCII" +"The " { $vocab-link "ascii" } " vocabulary implements support for the legacy ASCII character set. Most applications should use " { $link "unicode" } " instead." +$nl +"ASCII character classes:" { $subsection blank? } { $subsection letter? } { $subsection LETTER? } @@ -67,11 +69,10 @@ ARTICLE: "ascii" "ASCII character classes" { $subsection control? } { $subsection quotable? } { $subsection ascii? } -"ASCII case conversion is also implemented:" +"ASCII case conversion:" { $subsection ch>lower } { $subsection ch>upper } { $subsection >lower } -{ $subsection >upper } -"Modern applications should use Unicode 5.1 instead (" { $vocab-link "unicode.categories" } ")." ; +{ $subsection >upper } ; ABOUT: "ascii" diff --git a/basis/ascii/ascii.factor b/basis/ascii/ascii.factor index a64a7b8eb5..193e847d27 100644 --- a/basis/ascii/ascii.factor +++ b/basis/ascii/ascii.factor @@ -1,41 +1,23 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.order sequences -combinators.short-circuit ; +USING: kernel math math.order sequences strings +combinators.short-circuit hints ; IN: ascii : ascii? ( ch -- ? ) 0 127 between? ; inline - : blank? ( ch -- ? ) " \t\n\r" member? ; inline - : letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline - : LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline - : digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline - : printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline +: control? ( ch -- ? ) "\0\e\r\n\t\u000008\u00007f" member? ; inline +: quotable? ( ch -- ? ) { [ printable? ] [ "\"\\" member? not ] } 1&& ; inline +: Letter? ( ch -- ? ) { [ letter? ] [ LETTER? ] } 1|| ; inline +: alpha? ( ch -- ? ) { [ Letter? ] [ digit? ] } 1|| ; inline +: ch>lower ( ch -- lower ) dup LETTER? [ HEX: 20 + ] when ; inline +: >lower ( str -- lower ) [ ch>lower ] map ; +: ch>upper ( ch -- upper ) dup letter? [ HEX: 20 - ] when ; inline +: >upper ( str -- upper ) [ ch>upper ] map ; -: control? ( ch -- ? ) - "\0\e\r\n\t\u000008\u00007f" member? ; inline - -: quotable? ( ch -- ? ) - dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline - -: Letter? ( ch -- ? ) - [ [ letter? ] [ LETTER? ] ] 1|| ; - -: alpha? ( ch -- ? ) - [ [ Letter? ] [ digit? ] ] 1|| ; - -: ch>lower ( ch -- lower ) - dup CHAR: A CHAR: Z between? [ HEX: 20 + ] when ; - -: >lower ( str -- lower ) - [ ch>lower ] map ; - -: ch>upper ( ch -- upper ) - dup CHAR: a CHAR: z between? [ HEX: 20 - ] when ; - -: >upper ( str -- upper ) - [ ch>upper ] map ; +HINTS: >lower string ; +HINTS: >upper string ; \ No newline at end of file From d4122b571517bc4565a2f7165c7b15f226fe6dc1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:03:49 -0600 Subject: [PATCH 04/15] Update Unicode docs --- basis/bootstrap/unicode/unicode.factor | 1 + .../unicode/categories/categories-docs.factor | 36 ++++++++++++------- basis/unicode/normalize/normalize-docs.factor | 16 ++++++--- basis/unicode/unicode-docs.factor | 12 +++++-- 4 files changed, 44 insertions(+), 21 deletions(-) diff --git a/basis/bootstrap/unicode/unicode.factor b/basis/bootstrap/unicode/unicode.factor index e69de29bb2..3530c9d99f 100644 --- a/basis/bootstrap/unicode/unicode.factor +++ b/basis/bootstrap/unicode/unicode.factor @@ -0,0 +1 @@ +USE: unicode \ No newline at end of file diff --git a/basis/unicode/categories/categories-docs.factor b/basis/unicode/categories/categories-docs.factor index a7fe8d1e02..b0870e28fb 100644 --- a/basis/unicode/categories/categories-docs.factor +++ b/basis/unicode/categories/categories-docs.factor @@ -1,49 +1,59 @@ -! Copyright (C) 2009 Your name. +! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel ; IN: unicode.categories HELP: LETTER -{ $class-description "The class of upper cased letters" } ; +{ $class-description "The class of upper cased letters." } ; HELP: Letter -{ $class-description "The class of letters" } ; +{ $class-description "The class of letters." } ; HELP: alpha -{ $class-description "The class of code points which are alphanumeric" } ; +{ $class-description "The class of alphanumeric characters." } ; HELP: blank -{ $class-description "The class of code points which are whitespace" } ; +{ $class-description "The class of whitespace characters." } ; HELP: character -{ $class-description "The class of numbers which are pre-defined Unicode code points" } ; +{ $class-description "The class of pre-defined Unicode code points." } ; HELP: control -{ $class-description "The class of control characters" } ; +{ $class-description "The class of control characters." } ; HELP: digit -{ $class-description "The class of code coints which are digits" } ; +{ $class-description "The class of digits." } ; HELP: letter -{ $class-description "The class of code points which are lower-cased letters" } ; +{ $class-description "The class of lower-cased letters." } ; HELP: printable -{ $class-description "The class of characters which are printable, as opposed to being control or formatting characters" } ; +{ $class-description "The class of characters which are printable, as opposed to being control or formatting characters." } ; HELP: uncased -{ $class-description "The class of letters which don't have a case" } ; +{ $class-description "The class of letters which don't have a case." } ; ARTICLE: "unicode.categories" "Character classes" -{ $vocab-link "unicode.categories" } " is a vocabulary which provides predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ascii" } " equivalents in most cases. Below are links to classes of characters, but note that each of these also has a predicate defined, which is usually more useful." +"The " { $vocab-link "unicode.categories" } " vocabulary implements predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ascii" } " equivalents in most cases. Each character class has an associated predicate word." { $subsection blank } +{ $subsection blank? } { $subsection letter } +{ $subsection letter? } { $subsection LETTER } +{ $subsection LETTER? } { $subsection Letter } +{ $subsection Letter? } { $subsection digit } +{ $subsection digit? } { $subsection printable } +{ $subsection printable? } { $subsection alpha } +{ $subsection alpha? } { $subsection control } +{ $subsection control? } { $subsection uncased } -{ $subsection character } ; +{ $subsection uncased? } +{ $subsection character } +{ $subsection character? } ; ABOUT: "unicode.categories" diff --git a/basis/unicode/normalize/normalize-docs.factor b/basis/unicode/normalize/normalize-docs.factor index 4b1e3485ef..453ab24388 100644 --- a/basis/unicode/normalize/normalize-docs.factor +++ b/basis/unicode/normalize/normalize-docs.factor @@ -4,7 +4,13 @@ IN: unicode.normalize ABOUT: "unicode.normalize" ARTICLE: "unicode.normalize" "Unicode normalization" -"The " { $vocab-link "unicode.normalize" "unicode.normalize" } " vocabulary defines words for normalizing Unicode strings. In Unicode, it is often possible to have multiple sequences of characters which really represent exactly the same thing. For example, to represent e with an acute accent above, there are two possible strings: \"e\\u000301\" (the e character, followed by the combining acute accent character) and \"\\u0000e9\" (a single character, e with an acute accent). There are four normalization forms: NFD, NFC, NFKD, and NFKC. Basically, in NFD and NFKD, everything is expanded, whereas in NFC and NFKC, everything is contracted. In NFKD and NFKC, more things are expanded and contracted. This is a process which loses some information, so it should be done only with care. Most of the world uses NFC to communicate, but for many purposes, NFD/NFKD is easier to process. For more information, see Unicode Standard Annex #15 and section 3 of the Unicode standard." +"The " { $vocab-link "unicode.normalize" "unicode.normalize" } " vocabulary defines words for normalizing Unicode strings." +$nl +"In Unicode, it is often possible to have multiple sequences of characters which really represent exactly the same thing. For example, to represent e with an acute accent above, there are two possible strings: " { $snippet "\"e\\u000301\"" } " (the e character, followed by the combining acute accent character) and " { $snippet "\"\\u0000e9\"" } " (a single character, e with an acute accent)." +$nl +"There are four normalization forms: NFD, NFC, NFKD, and NFKC. Basically, in NFD and NFKD, everything is expanded, whereas in NFC and NFKC, everything is contracted. In NFKD and NFKC, more things are expanded and contracted. This is a process which loses some information, so it should be done only with care." +$nl +"Most of the world uses NFC to communicate, but for many purposes, NFD/NFKD is easier to process. For more information, see Unicode Standard Annex #15 and section 3 of the Unicode standard." { $subsection nfc } { $subsection nfd } { $subsection nfkc } @@ -12,16 +18,16 @@ ARTICLE: "unicode.normalize" "Unicode normalization" HELP: nfc { $values { "string" string } { "nfc" "a string in NFC" } } -{ $description "Converts a string to Normalization Form C" } ; +{ $description "Converts a string to Normalization Form C." } ; HELP: nfd { $values { "string" string } { "nfd" "a string in NFD" } } -{ $description "Converts a string to Normalization Form D" } ; +{ $description "Converts a string to Normalization Form D." } ; HELP: nfkc { $values { "string" string } { "nfkc" "a string in NFKC" } } -{ $description "Converts a string to Normalization Form KC" } ; +{ $description "Converts a string to Normalization Form KC." } ; HELP: nfkd { $values { "string" string } { "nfkd" "a string in NFKD" } } -{ $description "Converts a string to Normalization Form KD" } ; +{ $description "Converts a string to Normalization Form KD." } ; diff --git a/basis/unicode/unicode-docs.factor b/basis/unicode/unicode-docs.factor index 5b7b7e9ab3..4ae326ac84 100644 --- a/basis/unicode/unicode-docs.factor +++ b/basis/unicode/unicode-docs.factor @@ -1,8 +1,14 @@ -USING: help.markup help.syntax ; +USING: help.markup help.syntax strings ; IN: unicode ARTICLE: "unicode" "Unicode" -"Unicode is a set of characters, or " { $emphasis "code points" } " covering what's used in most world writing systems. Any Factor string can hold any of these code points transparently; a factor string is a sequence of Unicode code points. Unicode is accompanied by several standard algorithms for common operations like encoding in files, capitalizing a string, finding the boundaries between words, etc. When a programmer is faced with a string manipulation problem, where the string represents human language, a Unicode algorithm is often much better than the naive one. This is not in terms of efficiency, but rather internationalization. Even English text that remains in ASCII is better served by the Unicode collation algorithm than a naive algorithm. The Unicode algorithms implemented here are:" +"The " { $vocab-link "unicode" } " vocabulary and its sub-vocabularies implement support for the Unicode 5.1 character set." +$nl +"The Unicode character set contains most of the world's writing systems. Unicode is intended as a replacement for, and is a superset of, such legacy character sets as ASCII, Latin1, MacRoman, and so on. Unicode characters are called " { $emphasis "code points" } "; Factor's " { $link "strings" } " are sequences of code points." +$nl +"The Unicode character set is accompanied by several standard algorithms for common operations like encoding text in files, capitalizing a string, finding the boundaries between words, and so on." +$nl +"The Unicode algorithms implemented by the " { $vocab-link "unicode" } " vocabulary are:" { $vocab-subsection "Case mapping" "unicode.case" } { $vocab-subsection "Collation and weak comparison" "unicode.collation" } { $vocab-subsection "Character classes" "unicode.categories" } @@ -11,6 +17,6 @@ ARTICLE: "unicode" "Unicode" "The following are mostly for internal use:" { $vocab-subsection "Unicode syntax" "unicode.syntax" } { $vocab-subsection "Unicode data tables" "unicode.data" } -{ $see-also "io.encodings" } ; +{ $see-also "ascii" "io.encodings" } ; ABOUT: "unicode" From 4d080b87851d9e1737833d12d5be9f4518a19b04 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:04:11 -0600 Subject: [PATCH 05/15] Fix bug in locals found by littledan: [let inside [let didn't work in top-level forms --- basis/locals/locals-tests.factor | 6 +++++- basis/locals/parser/parser.factor | 32 +++++++++++++++---------------- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index e7f0b74194..982674694a 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -490,4 +490,8 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ 10 ] [ [| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call -] unit-test \ No newline at end of file +] unit-test + +! Discovered by littledan +[ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test +[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test \ No newline at end of file diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index c5b34556bc..f6baaf9ba7 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. +! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators effects.parser -generic.parser kernel lexer locals.errors +generic.parser kernel lexer locals.errors fry locals.rewrite.closures locals.types make namespaces parser quotations sequences splitting words vocabs.parser ; IN: locals.parser @@ -56,19 +56,21 @@ SYMBOL: in-lambda? (parse-bindings) ] [ 2drop ] if ; +: with-bindings ( quot -- words assoc ) + '[ + in-lambda? on + _ H{ } make-assoc + ] { } make swap ; inline + : parse-bindings ( end -- bindings vars ) - [ - [ (parse-bindings) ] H{ } make-assoc - ] { } make swap ; + [ (parse-bindings) ] with-bindings ; : parse-bindings* ( end -- words assoc ) [ - [ - namespace push-locals - (parse-bindings) - namespace pop-locals - ] { } make-assoc - ] { } make swap ; + namespace push-locals + (parse-bindings) + namespace pop-locals + ] with-bindings ; : (parse-wbindings) ( end -- ) dup parse-binding dup [ @@ -77,9 +79,7 @@ SYMBOL: in-lambda? ] [ 2drop ] if ; : parse-wbindings ( end -- bindings vars ) - [ - [ (parse-wbindings) ] H{ } make-assoc - ] { } make swap ; + [ (parse-wbindings) ] with-bindings ; : parse-locals ( -- vars assoc ) "(" expect ")" parse-effect @@ -88,8 +88,8 @@ SYMBOL: in-lambda? : parse-locals-definition ( word -- word quot ) parse-locals \ ; (parse-lambda) - 2dup "lambda" set-word-prop - rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ; + [ "lambda" set-word-prop ] + [ rewrite-closures dup length 1 = [ first ] [ bad-lambda-rewrite ] if ] 2bi ; : (::) ( -- word def ) CREATE-WORD parse-locals-definition ; From 7360cd5b302dc1ee2779ba8cda8a824e74dc59a2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:04:19 -0600 Subject: [PATCH 06/15] Clean up some duplication in interpolate --- basis/interpolate/interpolate.factor | 29 +++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index 5e4805a8ac..778f94ab6f 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -1,9 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io kernel macros make multiline namespaces parser present sequences strings splitting fry accessors ; IN: interpolate +> '[ _ get present write ] ] + [ name>> @ '[ _ @ present write ] ] [ '[ _ write ] ] if - ] map [ ] join ; + ] map [ ] join ; inline : interpolate-locals ( string -- quot ) - parse-interpolate [ - dup interpolate-var? - [ name>> search '[ _ present write ] ] - [ '[ _ write ] ] - if - ] map [ ] join ; + [ search [ ] ] (interpolate) ; -: I[ "]I" parse-multiline-string - interpolate-locals parsed \ call parsed ; parsing +PRIVATE> + +MACRO: interpolate ( string -- ) + [ [ get ] ] (interpolate) ; + +: I[ + "]I" parse-multiline-string + interpolate-locals over push-all ; parsing From 7851aac222b2513c90e85b3c7f866b9fe331b554 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:04:35 -0600 Subject: [PATCH 07/15] Replace some usages of prepose with fry --- basis/bootstrap/image/image.factor | 18 ++++++++---------- basis/deques/deques.factor | 9 +++++---- basis/dlists/dlists.factor | 17 +++++++---------- basis/grouping/grouping.factor | 4 ++-- basis/unix/process/process.factor | 4 ++-- 5 files changed, 24 insertions(+), 28 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 3e3c4a93aa..08c75fec34 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien arrays byte-arrays generic assocs hashtables assocs hashtables.private io io.binary io.files io.encodings.binary @@ -8,9 +8,9 @@ vectors words quotations assocs system layouts splitting grouping growable classes classes.builtin classes.tuple classes.tuple.private words.private vocabs vocabs.loader source-files definitions debugger -quotations.private sequences.private combinators +quotations.private sequences.private combinators combinators.smart math.order math.private accessors -slots.private compiler.units ; +slots.private compiler.units fry ; IN: bootstrap.image : arch ( os cpu -- arch ) @@ -73,7 +73,7 @@ SYMBOL: objects : put-object ( n obj -- ) (objects) set-at ; : cache-object ( obj quot -- value ) - [ (objects) ] dip [ obj>> ] prepose cache ; inline + [ (objects) ] dip '[ obj>> @ ] cache ; inline ! Constants @@ -95,7 +95,7 @@ SYMBOL: objects SYMBOL: sub-primitives : make-jit ( quot rc rt offset -- quad ) - { [ { } make ] [ ] [ ] [ ] } spread 4array ; inline + [ [ { } make ] 3dip ] output>array ; inline : jit-define ( quot rc rt offset name -- ) [ make-jit ] dip set ; inline @@ -524,11 +524,9 @@ M: quotation ' ! Image output : (write-image) ( image -- ) - bootstrap-cell big-endian get [ - [ >be write ] curry each - ] [ - [ >le write ] curry each - ] if ; + bootstrap-cell big-endian get + [ '[ _ >be write ] each ] + [ '[ _ >le write ] each ] if ; : write-image ( image -- ) "Writing image to " write diff --git a/basis/deques/deques.factor b/basis/deques/deques.factor index f4e68c214b..73769cc4d2 100644 --- a/basis/deques/deques.factor +++ b/basis/deques/deques.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences math ; +USING: kernel sequences math fry ; IN: deques GENERIC: push-front* ( obj deque -- node ) @@ -34,7 +34,8 @@ GENERIC: deque-empty? ( deque -- ? ) [ peek-back ] [ pop-back* ] bi ; : slurp-deque ( deque quot -- ) - [ drop [ deque-empty? not ] curry ] - [ [ pop-back ] prepose curry ] 2bi [ ] while ; inline + [ drop '[ _ deque-empty? not ] ] + [ '[ _ pop-back @ ] ] + 2bi [ ] while ; inline MIXIN: deque diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor index dcff476166..8c575105d1 100644 --- a/basis/dlists/dlists.factor +++ b/basis/dlists/dlists.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007, 2008 Mackenzie Straight, Doug Coleman, +! Copyright (C) 2007, 2009 Mackenzie Straight, Doug Coleman, ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: combinators kernel math sequences accessors deques -search-deques summary hashtables ; +search-deques summary hashtables fry ; IN: dlists > ; [ front>> ] dip (dlist-find-node) ; inline : dlist-each-node ( dlist quot -- ) - [ f ] compose dlist-find-node 2drop ; inline + '[ @ f ] dlist-find-node 2drop ; inline : unlink-node ( dlist-node -- ) dup prev>> over next>> set-prev-when @@ -115,8 +115,7 @@ M: dlist pop-back* ( dlist -- ) normalize-front ; : dlist-find ( dlist quot -- obj/f ? ) - [ obj>> ] prepose - dlist-find-node [ obj>> t ] [ drop f f ] if ; inline + '[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline : dlist-contains? ( dlist quot -- ? ) dlist-find nip ; inline @@ -143,7 +142,7 @@ M: dlist delete-node ( dlist-node dlist -- ) ] if ; inline : delete-node-if ( dlist quot -- obj/f ) - [ obj>> ] prepose delete-node-if* drop ; inline + '[ obj>> @ ] delete-node-if* drop ; inline M: dlist clear-deque ( dlist -- ) f >>front @@ -151,7 +150,7 @@ M: dlist clear-deque ( dlist -- ) drop ; : dlist-each ( dlist quot -- ) - [ obj>> ] prepose dlist-each-node ; inline + '[ obj>> @ ] dlist-each-node ; inline : dlist>seq ( dlist -- seq ) [ ] accumulator [ dlist-each ] dip ; @@ -159,8 +158,6 @@ M: dlist clear-deque ( dlist -- ) : 1dlist ( obj -- dlist ) [ push-front ] keep ; M: dlist clone - [ - [ push-back ] curry dlist-each - ] keep ; + [ '[ _ push-back ] dlist-each ] keep ; INSTANCE: dlist deque diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 14210d6070..ec13e3a750 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.order strings arrays vectors sequences -sequences.private accessors ; +sequences.private accessors fry ; IN: grouping ] dip - [ first2-unsafe ] prepose all? + '[ first2-unsafe @ ] all? ] if ] if ; inline diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor index 6e83ea9a42..22757cdbe1 100644 --- a/basis/unix/process/process.factor +++ b/basis/unix/process/process.factor @@ -1,6 +1,6 @@ USING: kernel alien.c-types alien.strings sequences math alien.syntax unix vectors kernel namespaces continuations threads assocs vectors -io.backend.unix io.encodings.utf8 unix.utilities ; +io.backend.unix io.encodings.utf8 unix.utilities fry ; IN: unix.process ! Low-level Unix process launching utilities. These are used @@ -36,7 +36,7 @@ FUNCTION: int execve ( char* path, char** argv, char** envp ) ; [ [ first ] [ ] bi ] dip exec-with-env ; : with-fork ( child parent -- ) - [ [ fork-process dup zero? ] dip [ drop ] prepose ] dip + [ [ fork-process dup zero? ] dip '[ drop @ ] ] dip if ; inline CONSTANT: SIGKILL 9 From daf490e4ddad641e27e417e46c443875c39e6f56 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:04:44 -0600 Subject: [PATCH 08/15] Update strings docs to mention Unicode --- core/strings/strings-docs.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor index 88e47d5309..3a519e143b 100644 --- a/core/strings/strings-docs.factor +++ b/core/strings/strings-docs.factor @@ -22,9 +22,8 @@ $nl { $subsection 1string } "Since strings are sequences, basic string manipulation can be performed using sequence operations (" { $link "sequences" } "). More advanced functionality can be found in other vocabularies, including but not limited to:" { $list - { { $vocab-link "ascii" } " - traditional ASCII character classes" } - { { $vocab-link "unicode.categories" } " - Unicode character classes" } - { { $vocab-link "unicode.case" } " - Unicode case conversion" } + { { $link "ascii" } " - ASCII algorithms for interoperability with legacy applications" } + { { $link "unicode" } " - Unicode algorithms for modern multilingual applications" } { { $vocab-link "regexp" } " - regular expressions" } { { $vocab-link "peg" } " - parser expression grammars" } } ; From 3458f8bbef7961dbddca30216a8f1882d6b8f38b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 25 Jan 2009 23:20:17 -0600 Subject: [PATCH 09/15] Fix bug in re-split reported by kib2 --- basis/regexp/regexp-tests.factor | 16 ++++++++++------ basis/regexp/regexp.factor | 5 ++++- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index c2f7bb5bc6..1cd9a2392e 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -287,9 +287,13 @@ IN: regexp-tests [ { "1" "2" "3" "4" } ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test -[ { "1" "2" "3" "4" } ] +[ { "1" "2" "3" "4" "" } ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test +[ { "" } ] [ "" R/ =/ re-split [ >string ] map ] unit-test + +[ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test + [ { "ABC" "DEF" "GHI" } ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test @@ -299,16 +303,16 @@ IN: regexp-tests [ 0 ] [ "123" R/ [A-Z]+/ count-matches ] unit-test -[ "1.2.3.4" ] +[ "1.2.3.4." ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test - -[ "-- title --" ] [ "== title ==" "=" "-" re-replace ] unit-test + +[ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test /* ! FIXME [ f ] [ "ab" "a(?!b)" first-match ] unit-test [ "a" ] [ "ac" "a(?!b)" first-match >string ] unit-test -! [ t ] [ "fxxbar" "(?!foo).{3}bar" matches? ] unit-test +[ t ] [ "fxxbar" "(?!foo).{3}bar" matches? ] unit-test [ f ] [ "foobar" "(?!foo).{3}bar" matches? ] unit-test [ "a" ] [ "ab" "a(?=b)(?=b)" first-match >string ] unit-test [ "a" ] [ "ba" "a(?<=b)(?<=b)" first-match >string ] unit-test @@ -319,7 +323,7 @@ IN: regexp-tests */ ! Bug in parsing word -[ t ] [ "a" R' a' matches? ] unit-test +[ t ] [ "a" R' a' matches? ] unit-test ! Convert to lowercase until E [ f ] [ "AA" R/ \LAA\E/ matches? ] unit-test diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index c615719cc4..86f978373b 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -61,8 +61,11 @@ IN: regexp dupd first-match [ split1-slice swap ] [ "" like f swap ] if* ; +: (re-split) ( string regexp -- ) + over [ [ re-cut , ] keep (re-split) ] [ 2drop ] if ; + : re-split ( string regexp -- seq ) - [ dup length 0 > ] swap '[ _ re-cut ] [ ] produce nip ; + [ (re-split) ] { } make ; : re-replace ( string regexp replacement -- result ) [ re-split ] dip join ; From c33dd1105b8e652cff1f6a32a8a569da21065613 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 25 Jan 2009 23:52:25 -0600 Subject: [PATCH 10/15] XML fry --- basis/xml/elements/elements.factor | 8 +-- .../xml/interpolate/interpolate-tests.factor | 23 +++++++-- basis/xml/interpolate/interpolate.factor | 49 +++++++++++++------ 3 files changed, 58 insertions(+), 22 deletions(-) diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index 40ca0fd32e..b2280bacb4 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -8,9 +8,11 @@ IN: xml.elements : take-interpolated ( quot -- interpolated ) interpolating? get [ - drop pass-blank - " \t\r\n-" take-to - pass-blank "->" expect + drop get-char CHAR: > = + [ next f ] [ + pass-blank " \t\r\n-" take-to + pass-blank "->" expect + ] if ] [ call ] if ; inline : interpolate-quote ( -- interpolated ) diff --git a/basis/xml/interpolate/interpolate-tests.factor b/basis/xml/interpolate/interpolate-tests.factor index 6db97268b9..48f76b8746 100644 --- a/basis/xml/interpolate/interpolate-tests.factor +++ b/basis/xml/interpolate/interpolate-tests.factor @@ -2,11 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: tools.test xml.interpolate multiline kernel assocs sequences accessors xml.writer xml.interpolate.private -locals ; +locals splitting ; IN: xml.interpolate.tests -[ "a" "c" { "a" "c" } ] [ - "<-a->/>" +[ "a" "c" { "a" "c" f } ] [ + "<-a->/><->" interpolated-doc [ second var>> ] [ fourth "val" swap at var>> ] @@ -27,3 +27,20 @@ IN: xml.interpolate.tests XML> pprint-xml>string ] ] unit-test + +[ {" + + + one + + + two + + + three + +"} ] [ + "one two three" " " split + [ [XML <-> XML] ] map + <-> XML> pprint-xml>string +] unit-test diff --git a/basis/xml/interpolate/interpolate.factor b/basis/xml/interpolate/interpolate.factor index cc5233f829..7b041ec53d 100644 --- a/basis/xml/interpolate/interpolate.factor +++ b/basis/xml/interpolate/interpolate.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: xml xml.state kernel sequences fry assocs xml.data accessors strings make multiline parser namespaces macros -sequences.deep ; +sequences.deep generalizations locals words combinators +math ; IN: xml.interpolate > values + [ interpolated? ] filter + swap each ; +M: object (each-interpolated) 2drop ; + +: each-interpolated ( xml quot -- ) + '[ _ (each-interpolated) ] deep-each ; inline + +:: number<-> ( doc -- doc ) + 0 :> n! doc [ + dup var>> [ n >>var n 1+ n! ] unless drop + ] each-interpolated doc ; + MACRO: interpolate-xml ( string -- doc ) - interpolated-doc '[ _ interpolate-xml-doc ] ; + interpolated-doc number<-> '[ _ interpolate-xml-doc ] ; MACRO: interpolate-chunk ( string -- chunk ) - interpolated-chunk '[ _ interpolate-sequence ] ; + interpolated-chunk number<-> '[ _ interpolate-sequence ] ; : >search-hash ( seq -- hash ) [ dup search ] H{ } map>assoc ; -GENERIC: extract-item ( item -- ) -M: interpolated extract-item var>> , ; -M: tag extract-item - attrs>> values - [ interpolated? ] filter - [ var>> , ] each ; -M: object extract-item drop ; - : extract-variables ( xml -- seq ) - [ [ extract-item ] deep-each ] { } make ; + [ [ var>> , ] each-interpolated ] { } make ; + +: collect ( accum seq -- accum ) + { + { [ dup [ ] all? ] [ >search-hash parsed ] } ! locals + { [ dup [ not ] all? ] [ ! fry + length parsed \ narray parsed \ parsed + ] } + [ drop "XML interpolation contains both fry and locals" throw ] ! mixed + } cond ; : parse-def ( accum delimiter word -- accum ) [ - parse-multiline-string [ - interpolated-chunk extract-variables - >search-hash parsed - ] keep parsed + parse-multiline-string + [ interpolated-chunk extract-variables collect ] keep + parsed ] dip parsed ; PRIVATE> From ef8747ee7238bfea96453b6eba5d982e937d2bba Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 25 Jan 2009 23:53:02 -0600 Subject: [PATCH 11/15] Syndication uses new xml.interpolate vocab --- basis/syndication/syndication-tests.factor | 3 +- basis/syndication/syndication.factor | 45 ++++++++++++---------- 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/basis/syndication/syndication-tests.factor b/basis/syndication/syndication-tests.factor index 1ddcbf8090..4fbfee03d9 100644 --- a/basis/syndication/syndication-tests.factor +++ b/basis/syndication/syndication-tests.factor @@ -1,5 +1,5 @@ USING: syndication io kernel io.files tools.test io.encodings.utf8 -calendar urls ; +calendar urls xml.writer ; IN: syndication.tests \ download-feed must-infer @@ -43,3 +43,4 @@ IN: syndication.tests } } } ] [ "resource:basis/syndication/test/atom.xml" load-news-file ] unit-test +[ ] [ "resource:basis/syndication/test/atom.xml" load-news-file xml>string drop ] unit-test diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index c82fe4006d..5b6efdcf06 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -4,7 +4,7 @@ USING: xml.utilities kernel assocs xml.generator math.order strings sequences xml.data xml.writer io.streams.string combinators xml xml.entities.html io.files io - http.client namespaces make xml.generator hashtables + http.client namespaces make xml.interpolate hashtables calendar.format accessors continuations urls present ; IN: syndication @@ -114,26 +114,29 @@ TUPLE: entry title url description date ; http-get nip string>feed ; ! Atom generation -: simple-tag, ( content name -- ) - [ , ] tag, ; -: simple-tag*, ( content name attrs -- ) - [ , ] tag*, ; - -: entry, ( entry -- ) - "entry" [ - { - [ title>> "title" { { "type" "html" } } simple-tag*, ] - [ url>> present "href" associate "link" swap contained*, ] - [ date>> timestamp>rfc3339 "published" simple-tag, ] - [ description>> [ "content" { { "type" "html" } } simple-tag*, ] when* ] - } cleave - ] tag, ; +: entry>xml ( entry -- xml ) + { + [ title>> ] + [ url>> present ] + [ date>> timestamp>rfc3339 ] + [ description>> ] + } cleave + [XML + + <-> + /> + <-> + <-> + + XML] ; : feed>xml ( feed -- xml ) - "feed" { { "xmlns" "http://www.w3.org/2005/Atom" } } [ - [ title>> "title" simple-tag, ] - [ url>> present "href" associate "link" swap contained*, ] - [ entries>> [ entry, ] each ] - tri - ] make-xml* ; + [ title>> ] [ url>> present ] [ entries>> [ entry>xml ] map ] tri + + <-> + /> + <-> + + XML> ; From 2f177a194b28df5e1d79139fb6ad244fa8e1dfc6 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 26 Jan 2009 00:05:13 -0600 Subject: [PATCH 12/15] Removing old XML generation library --- basis/syndication/syndication.factor | 6 ++- basis/xml/generator/authors.txt | 1 - basis/xml/generator/generator-tests.factor | 3 -- basis/xml/generator/generator.factor | 25 ---------- unmaintained/xml/syntax/syntax.factor | 58 ---------------------- 5 files changed, 4 insertions(+), 89 deletions(-) delete mode 100755 basis/xml/generator/authors.txt delete mode 100644 basis/xml/generator/generator-tests.factor delete mode 100644 basis/xml/generator/generator.factor delete mode 100644 unmaintained/xml/syntax/syntax.factor diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index 5b6efdcf06..4f28ea12c0 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -1,7 +1,7 @@ ! 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 xml.generator math.order +USING: xml.utilities 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.interpolate hashtables @@ -132,7 +132,9 @@ TUPLE: entry title url description date ; XML] ; : feed>xml ( feed -- xml ) - [ title>> ] [ url>> present ] [ entries>> [ entry>xml ] map ] tri + [ title>> ] + [ url>> present ] + [ entries>> [ entry>xml ] map ] tri <-> diff --git a/basis/xml/generator/authors.txt b/basis/xml/generator/authors.txt deleted file mode 100755 index f990dd0ed2..0000000000 --- a/basis/xml/generator/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/basis/xml/generator/generator-tests.factor b/basis/xml/generator/generator-tests.factor deleted file mode 100644 index 17f7cab509..0000000000 --- a/basis/xml/generator/generator-tests.factor +++ /dev/null @@ -1,3 +0,0 @@ -USING: tools.test io.streams.string xml.generator xml.writer accessors ; -[ "" ] -[ "html" [ "body" [ "a" { { "href" "blah" } } contained*, ] tag, ] make-xml [ body>> write-xml-chunk ] with-string-writer ] unit-test diff --git a/basis/xml/generator/generator.factor b/basis/xml/generator/generator.factor deleted file mode 100644 index ac7b14b89e..0000000000 --- a/basis/xml/generator/generator.factor +++ /dev/null @@ -1,25 +0,0 @@ -! Copyright (C) 2006, 2007 Daniel Ehrenberg -! See http://factorcode.org/license.txt for BSD license. -USING: namespaces make kernel xml.data xml.utilities assocs -sequences ; -IN: xml.generator - -: comment, ( string -- ) , ; -: instruction, ( string -- ) , ; -: nl, ( -- ) "\n" , ; - -: (tag,) ( name attrs quot -- tag ) - -rot [ V{ } make ] 2dip rot ; inline -: tag*, ( name attrs quot -- ) - (tag,) , ; inline - -: contained*, ( name attrs -- ) - f , ; - -: tag, ( name quot -- ) f swap tag*, ; inline -: contained, ( name -- ) f contained*, ; inline - -: make-xml* ( name attrs quot -- xml ) - (tag,) build-xml ; inline -: make-xml ( name quot -- xml ) - f swap make-xml* ; inline diff --git a/unmaintained/xml/syntax/syntax.factor b/unmaintained/xml/syntax/syntax.factor deleted file mode 100644 index 91b31ec7e6..0000000000 --- a/unmaintained/xml/syntax/syntax.factor +++ /dev/null @@ -1,58 +0,0 @@ -! Copyright (C) 2008 Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: lexer parser splitting kernel quotations namespaces make -sequences assocs sequences.lib xml.generator xml.utilities -xml.data ; -IN: xml.syntax - -: parsed-name ( accum -- accum ) - scan ":" split1 [ f ] [ ] if* parsed ; - -: run-combinator ( accum quot1 quot2 -- accum ) - >r [ ] like parsed r> [ parsed ] each ; - -: parse-tag-contents ( accum contained? -- accum ) - [ \ contained*, parsed ] [ - scan-word \ [ = - [ POSTPONE: [ \ tag*, parsed ] - [ "Expected [ missing" throw ] if - ] if ; - -DEFER: >> - -: attributes-parsed ( accum quot -- accum ) - [ f parsed ] [ - >r \ >r parsed r> parsed - [ H{ } make-assoc r> swap ] [ parsed ] each - ] if-empty ; - -: << - parsed-name [ - \ >> parse-until >quotation - attributes-parsed \ contained? get - ] with-scope parse-tag-contents ; parsing - -: == - \ call parsed parsed-name \ set parsed ; parsing - -: // - \ contained? on ; parsing - -: parse-special ( accum end-token word -- accum ) - >r parse-tokens " " join parsed r> parsed ; - -: " \ comment, parse-special ; parsing - -: " \ directive, parse-special ; parsing - -: " \ instruction, parse-special ; parsing - -: >xml-document ( seq -- xml ) - dup first prolog? [ unclip-slice ] [ standard-prolog ] if swap - [ tag? ] split-around ; - -DEFER: XML> - -: [ >quotation ] parse-literal - { } parsed \ make parsed \ >xml-document parsed ; parsing From 1c65b61f804c7689a41093df3483def36a5593fb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 26 Jan 2009 02:39:15 -0600 Subject: [PATCH 13/15] Make interpolate-locals public again --- basis/interpolate/interpolate.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index 778f94ab6f..5c859f8947 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -30,14 +30,14 @@ TUPLE: interpolate-var name ; if ] map [ ] join ; inline -: interpolate-locals ( string -- quot ) - [ search [ ] ] (interpolate) ; - PRIVATE> MACRO: interpolate ( string -- ) [ [ get ] ] (interpolate) ; +: interpolate-locals ( string -- quot ) + [ search [ ] ] (interpolate) ; + : I[ "]I" parse-multiline-string interpolate-locals over push-all ; parsing From 2c4f6ffd79643ee56fc2a845f635181cacedac11 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 26 Jan 2009 04:48:50 -0600 Subject: [PATCH 14/15] Fix syndication unit test --- basis/syndication/syndication-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/syndication/syndication-tests.factor b/basis/syndication/syndication-tests.factor index 4fbfee03d9..8cfdc9e1d5 100644 --- a/basis/syndication/syndication-tests.factor +++ b/basis/syndication/syndication-tests.factor @@ -43,4 +43,4 @@ IN: syndication.tests } } } ] [ "resource:basis/syndication/test/atom.xml" load-news-file ] unit-test -[ ] [ "resource:basis/syndication/test/atom.xml" load-news-file xml>string drop ] unit-test +[ ] [ "resource:basis/syndication/test/atom.xml" load-news-file feed>xml xml>string drop ] unit-test From c440b889eaa4e0bc02ab0aa1ed95ff1adb87e2db Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 26 Jan 2009 04:51:59 -0600 Subject: [PATCH 15/15] Fix make-image --- basis/bootstrap/image/image.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 08c75fec34..cb8c0ef538 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -8,7 +8,7 @@ vectors words quotations assocs system layouts splitting grouping growable classes classes.builtin classes.tuple classes.tuple.private words.private vocabs vocabs.loader source-files definitions debugger -quotations.private sequences.private combinators combinators.smart +quotations.private sequences.private combinators math.order math.private accessors slots.private compiler.units fry ; IN: bootstrap.image @@ -95,7 +95,7 @@ SYMBOL: objects SYMBOL: sub-primitives : make-jit ( quot rc rt offset -- quad ) - [ [ { } make ] 3dip ] output>array ; inline + [ { } make ] 3dip 4array ; inline : jit-define ( quot rc rt offset name -- ) [ make-jit ] dip set ; inline