extra/xml/syntax/syntax.factor

   1 ! Copyright (C) 2008 Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: lexer parser splitting kernel quotations namespaces
   4 sequences assocs sequences.lib xml.generator xml.utilities
   5 xml.data ;
   6 IN: xml.syntax
   7
   8 : parsed-name ( accum -- accum )
   9     scan ":" split1 [ f <name> ] [ <simple-name> ] if* parsed ;
  10
  11 : run-combinator ( accum quot1 quot2 -- accum )
  12     >r [ ] like parsed r> [ parsed ] each ;
  13
  14 : parse-tag-contents ( accum contained? -- accum )
  15     [ \ contained*, parsed ] [
  16         scan-word \ [ =
  17         [ POSTPONE: [ \ tag*, parsed ]
  18         [ "Expected [ missing" throw ] if
  19     ] if ;
  20
  21 DEFER: >>
  22
  23 : attributes-parsed ( accum quot -- accum )
  24     [ f parsed ] [
  25         >r \ >r parsed r> parsed
  26         [ H{ } make-assoc r> swap ] [ parsed ] each
  27     ] if-empty ;
  28
  29 : <<
  30     parsed-name [
  31         \ >> parse-until >quotation
  32         attributes-parsed \ contained? get
  33     ] with-scope parse-tag-contents ; parsing
  34
  35 : ==
  36     \ call parsed parsed-name \ set parsed ; parsing
  37
  38 : //
  39     \ contained? on ; parsing
  40
  41 : parse-special ( accum end-token word -- accum )
  42     >r parse-tokens " " join parsed r> parsed ;
  43
  44 : <!-- "-->" \ comment, parse-special ; parsing
  45
  46 : <!  ">" \ directive, parse-special ; parsing
  47
  48 : <? "?>" \ instruction, parse-special ; parsing
  49
  50 : >xml-document ( seq -- xml )
  51     dup first prolog? [ unclip-slice ] [ standard-prolog ] if swap
  52     [ tag? ] split-around <xml> ;
  53
  54 DEFER: XML>
  55
  56 : <XML
  57     \ XML> [ >quotation ] parse-literal
  58     { } parsed \ make parsed \ >xml-document parsed ; parsing