! 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 combinators locals xml.data memoize sequences.deep
-xml.data xml.state xml namespaces present arrays generalizations strings
-make math macros multiline inverse combinators.short-circuit
-sorting fry unicode.categories ;
+USING: words assocs kernel accessors parser vocabs.parser effects.parser
+sequences summary lexer splitting combinators locals
+memoize sequences.deep xml.data xml.state xml namespaces present
+arrays generalizations strings make math macros multiline
+inverse combinators.short-circuit sorting fry unicode.categories
+effects ;
IN: xml.syntax
<PRIVATE
>alist swap '[ _ no-tag boa throw ] suffix
'[ dup main>> _ case ] ;
-: define-tags ( word -- )
- dup dup "xtable" word-prop compile-tags define ;
+: define-tags ( word effect -- )
+ [ dup dup "xtable" word-prop compile-tags ] dip define-declared ;
:: define-tag ( string word quot -- )
quot string word "xtable" word-prop set-at
- word define-tags ;
+ word word stack-effect define-tags ;
PRIVATE>
-: TAGS:
- CREATE
- [ H{ } clone "xtable" set-word-prop ]
- [ define-tags ] bi ; parsing
+SYNTAX: TAGS:
+ CREATE-WORD complete-effect
+ [ drop H{ } clone "xtable" set-word-prop ]
+ [ define-tags ]
+ 2bi ;
-: TAG:
- scan scan-word parse-definition define-tag ; parsing
+SYNTAX: TAG:
+ scan scan-word parse-definition define-tag ;
-: XML-NS:
- CREATE-WORD (( string -- name )) over set-stack-effect
- scan '[ f swap _ <name> ] define-memoized ; parsing
+SYNTAX: XML-NS:
+ CREATE-WORD scan '[ f swap _ <name> ] (( string -- name )) define-memoized ;
<PRIVATE
: number<-> ( doc -- dup )
0 over [
dup var>> [
- over >>var [ 1+ ] dip
+ over >>var [ 1 + ] dip
] unless drop
] each-interpolated drop ;
PRIVATE>
-: <XML
- "XML>" [ string>doc ] parse-def ; parsing
+SYNTAX: <XML
+ "XML>" [ string>doc ] parse-def ;
-: [XML
- "XML]" [ string>chunk ] parse-def ; parsing
+SYNTAX: [XML
+ "XML]" [ string>chunk ] parse-def ;
+
+<PRIVATE
: remove-blanks ( seq -- newseq )
[ { [ string? not ] [ [ blank? ] all? not ] } 1|| ] filter ;
[undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
\ interpolate-xml 1 [ undo-xml ] define-pop-inverse
+
+PRIVATE>