basis/peg/ebnf/ebnf.factor

   1 ! Copyright (C) 2007 Chris Double.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: kernel words arrays strings math.parser\r
   4 sequences quotations vectors namespaces make math assocs\r
   5 continuations peg peg.parsers unicode.categories multiline\r
   6 splitting accessors effects sequences.deep peg.search\r
   7 combinators.short-circuit lexer io.streams.string stack-checker\r
   8 io combinators parser summary ;\r
   9 FROM: compiler.units => with-compilation-unit ;\r
  10 FROM: vocabs.parser => search ;\r
  11 IN: peg.ebnf\r
  12 \r
  13 : rule ( name word -- parser )\r
  14   #! Given an EBNF word produced from EBNF: return the EBNF rule\r
  15   "ebnf-parser" word-prop at ;\r
  16 \r
  17 ERROR: no-rule rule parser ;\r
  18 \r
  19 <PRIVATE\r
  20 \r
  21 : lookup-rule ( rule parser -- rule' )\r
  22     2dup rule [ 2nip ] [ no-rule ] if* ; \r
  23 \r
  24 TUPLE: tokenizer any one many ;\r
  25 \r
  26 : default-tokenizer ( -- tokenizer )\r
  27   T{ tokenizer f \r
  28     [ any-char ]\r
  29     [ token ]\r
  30     [ [ = ] curry any-char swap semantic ]\r
  31   } ;\r
  32 \r
  33 : parser-tokenizer ( parser -- tokenizer )\r
  34   [ 1quotation ] keep\r
  35   [ swap [ = ] curry semantic ] curry dup \ tokenizer boa ;\r
  36 \r
  37 : rule-tokenizer ( name word -- tokenizer )\r
  38   rule parser-tokenizer ;\r
  39 \r
  40 : tokenizer ( -- word )\r
  41   \ tokenizer get-global [ default-tokenizer ] unless* ;\r
  42 \r
  43 : reset-tokenizer ( -- )\r
  44   default-tokenizer \ tokenizer set-global ;\r
  45 \r
  46 ERROR: no-tokenizer name ;\r
  47 \r
  48 M: no-tokenizer summary\r
  49     drop "Tokenizer not found" ;\r
  50 \r
  51 SYNTAX: TOKENIZER: \r
  52   scan-word-name dup search [ nip ] [ no-tokenizer ] if*\r
  53   execute( -- tokenizer ) \ tokenizer set-global ;\r
  54 \r
  55 TUPLE: ebnf-non-terminal symbol ;\r
  56 TUPLE: ebnf-terminal symbol ;\r
  57 TUPLE: ebnf-foreign word rule ;\r
  58 TUPLE: ebnf-any-character ;\r
  59 TUPLE: ebnf-range pattern ;\r
  60 TUPLE: ebnf-ensure group ;\r
  61 TUPLE: ebnf-ensure-not group ;\r
  62 TUPLE: ebnf-choice options ;\r
  63 TUPLE: ebnf-sequence elements ;\r
  64 TUPLE: ebnf-ignore group ;\r
  65 TUPLE: ebnf-repeat0 group ;\r
  66 TUPLE: ebnf-repeat1 group ;\r
  67 TUPLE: ebnf-optional group ;\r
  68 TUPLE: ebnf-whitespace group ;\r
  69 TUPLE: ebnf-tokenizer elements ;\r
  70 TUPLE: ebnf-rule symbol elements ;\r
  71 TUPLE: ebnf-action parser code ;\r
  72 TUPLE: ebnf-var parser name ;\r
  73 TUPLE: ebnf-semantic parser code ;\r
  74 TUPLE: ebnf rules ;\r
  75 \r
  76 C: <ebnf-non-terminal> ebnf-non-terminal\r
  77 C: <ebnf-terminal> ebnf-terminal\r
  78 C: <ebnf-foreign> ebnf-foreign\r
  79 C: <ebnf-any-character> ebnf-any-character\r
  80 C: <ebnf-range> ebnf-range\r
  81 C: <ebnf-ensure> ebnf-ensure\r
  82 C: <ebnf-ensure-not> ebnf-ensure-not\r
  83 C: <ebnf-choice> ebnf-choice\r
  84 C: <ebnf-sequence> ebnf-sequence\r
  85 C: <ebnf-ignore> ebnf-ignore\r
  86 C: <ebnf-repeat0> ebnf-repeat0\r
  87 C: <ebnf-repeat1> ebnf-repeat1\r
  88 C: <ebnf-optional> ebnf-optional\r
  89 C: <ebnf-whitespace> ebnf-whitespace\r
  90 C: <ebnf-tokenizer> ebnf-tokenizer\r
  91 C: <ebnf-rule> ebnf-rule\r
  92 C: <ebnf-action> ebnf-action\r
  93 C: <ebnf-var> ebnf-var\r
  94 C: <ebnf-semantic> ebnf-semantic\r
  95 C: <ebnf> ebnf\r
  96 \r
  97 : filter-hidden ( seq -- seq )\r
  98   #! Remove elements that produce no AST from sequence\r
  99   [ ebnf-ensure-not? not ] filter [ ebnf-ensure? not ] filter ;\r
 100 \r
 101 : syntax ( string -- parser )\r
 102   #! Parses the string, ignoring white space, and\r
 103   #! does not put the result in the AST.\r
 104   token sp hide ;\r
 105 \r
 106 : syntax-pack ( begin parser end -- parser )\r
 107   #! Parse 'parser' surrounded by syntax elements\r
 108   #! begin and end.\r
 109   [ syntax ] 2dip syntax pack ;\r
 110 \r
 111 #! Don't want to use 'replace' in an action since replace doesn't infer.\r
 112 #! Do the compilation of the peg at parse time and call (replace).\r
 113 PEG: escaper ( string -- ast )\r
 114   [\r
 115     "\\t" token [ drop "\t" ] action ,\r
 116     "\\n" token [ drop "\n" ] action ,\r
 117     "\\r" token [ drop "\r" ] action ,\r
 118     "\\\\" token [ drop "\\" ] action ,\r
 119   ] choice* any-char-parser 2array choice repeat0 ;\r
 120 \r
 121 : replace-escapes ( string -- string )\r
 122   escaper sift [ [ tree-write ] each ] with-string-writer ;\r
 123 \r
 124 : insert-escapes ( string -- string )\r
 125   [\r
 126     "\t" token [ drop "\\t" ] action ,\r
 127     "\n" token [ drop "\\n" ] action ,\r
 128     "\r" token [ drop "\\r" ] action ,\r
 129   ] choice* replace ;\r
 130 \r
 131 : 'identifier' ( -- parser )\r
 132   #! Return a parser that parses an identifer delimited by\r
 133   #! a quotation character. The quotation can be single\r
 134   #! or double quotes. The AST produced is the identifier\r
 135   #! between the quotes.\r
 136   [\r
 137     [ CHAR: " = not ] satisfy repeat1 "\"" "\"" surrounded-by ,\r
 138     [ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,\r
 139   ] choice* [ >string replace-escapes ] action ;\r
 140   \r
 141 : 'non-terminal' ( -- parser )\r
 142   #! A non-terminal is the name of another rule. It can\r
 143   #! be any non-blank character except for characters used\r
 144   #! in the EBNF syntax itself.\r
 145   [\r
 146     {\r
 147       [ blank?    ]\r
 148       [ CHAR: " = ]\r
 149       [ CHAR: ' = ]\r
 150       [ CHAR: | = ]\r
 151       [ CHAR: { = ]\r
 152       [ CHAR: } = ]\r
 153       [ CHAR: = = ]\r
 154       [ CHAR: ) = ]\r
 155       [ CHAR: ( = ]\r
 156       [ CHAR: ] = ]\r
 157       [ CHAR: [ = ]\r
 158       [ CHAR: . = ]\r
 159       [ CHAR: ! = ]\r
 160       [ CHAR: & = ]\r
 161       [ CHAR: * = ]\r
 162       [ CHAR: + = ]\r
 163       [ CHAR: ? = ]\r
 164       [ CHAR: : = ]\r
 165       [ CHAR: ~ = ]\r
 166       [ CHAR: < = ]\r
 167       [ CHAR: > = ]\r
 168     } 1|| not\r
 169   ] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;\r
 170 \r
 171 : 'terminal' ( -- parser )\r
 172   #! A terminal is an identifier enclosed in quotations\r
 173   #! and it represents the literal value of the identifier.\r
 174   'identifier' [ <ebnf-terminal> ] action ;\r
 175 \r
 176 : 'foreign-name' ( -- parser )\r
 177   #! Parse a valid foreign parser name\r
 178   [\r
 179     {\r
 180       [ blank?    ]\r
 181       [ CHAR: > = ]\r
 182     } 1|| not\r
 183   ] satisfy repeat1 [ >string ] action ;\r
 184 \r
 185 : 'foreign' ( -- parser )\r
 186   #! A foreign call is a call to a rule in another ebnf grammar\r
 187   [\r
 188     "<foreign" syntax ,\r
 189     'foreign-name' sp ,\r
 190     'foreign-name' sp optional ,\r
 191     ">" syntax ,\r
 192   ] seq* [ first2 <ebnf-foreign> ] action ;\r
 193 \r
 194 : 'any-character' ( -- parser )\r
 195   #! A parser to match the symbol for any character match.\r
 196   [ CHAR: . = ] satisfy [ drop <ebnf-any-character> ] action ;\r
 197 \r
 198 : 'range-parser' ( -- parser )\r
 199   #! Match the syntax for declaring character ranges\r
 200   [\r
 201     [ "[" syntax , "[" token ensure-not , ] seq* hide ,\r
 202     [ CHAR: ] = not ] satisfy repeat1 , \r
 203     "]" syntax ,\r
 204   ] seq* [ first >string <ebnf-range> ] action ;\r
 205  \r
 206 : ('element') ( -- parser )\r
 207   #! An element of a rule. It can be a terminal or a \r
 208   #! non-terminal but must not be followed by a "=". \r
 209   #! The latter indicates that it is the beginning of a\r
 210   #! new rule.\r
 211   [\r
 212     [\r
 213       [ \r
 214         'non-terminal' ,\r
 215         'terminal' ,\r
 216         'foreign' ,\r
 217         'range-parser' ,\r
 218         'any-character' ,\r
 219       ] choice* \r
 220       [ dup , "~" token hide , ] seq* [ first <ebnf-ignore> ] action ,\r
 221       [ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action ,\r
 222       [ dup , "+" token hide , ] seq* [ first <ebnf-repeat1> ] action ,\r
 223       [ dup , "?[" token ensure-not , "?" token hide , ] seq* [ first <ebnf-optional> ] action ,\r
 224       ,\r
 225     ] choice* ,\r
 226     [\r
 227       "=" syntax ensure-not ,\r
 228       "=>" syntax ensure ,\r
 229     ] choice* ,\r
 230   ] seq* [ first ] action ;\r
 231 \r
 232 DEFER: 'action'\r
 233 \r
 234 : 'element' ( -- parser )\r
 235   [\r
 236     [\r
 237       ('element') , ":" syntax ,\r
 238       "a-zA-Z_" range-pattern\r
 239       "a-zA-Z0-9_-" range-pattern repeat1 2seq [ first2 swap prefix >string ] action ,\r
 240     ] seq* [ first2 <ebnf-var> ] action ,\r
 241     ('element') ,\r
 242   ] choice* ;\r
 243 \r
 244 DEFER: 'choice'\r
 245 \r
 246 : grouped ( quot suffix  -- parser )\r
 247   #! Parse a group of choices, with a suffix indicating\r
 248   #! the type of group (repeat0, repeat1, etc) and\r
 249   #! an quot that is the action that produces the AST.\r
 250   2dup\r
 251   [\r
 252     "(" [ 'choice' sp ] delay ")" syntax-pack \r
 253     swap 2seq  \r
 254     [ first ] rot compose action ,\r
 255     "{" [ 'choice' sp ] delay "}" syntax-pack \r
 256     swap 2seq  \r
 257     [ first <ebnf-whitespace> ] rot compose action ,\r
 258   ] choice* ;\r
 259   \r
 260 : 'group' ( -- parser )\r
 261   #! A grouping with no suffix. Used for precedence.\r
 262   [ ] [\r
 263     "~" token sp ensure-not ,\r
 264     "*" token sp ensure-not ,\r
 265     "+" token sp ensure-not ,\r
 266     "?" token sp ensure-not ,\r
 267   ] seq* hide grouped ; \r
 268 \r
 269 : 'ignore' ( -- parser )\r
 270   [ <ebnf-ignore> ] "~" syntax grouped ;\r
 271 \r
 272 : 'repeat0' ( -- parser )\r
 273   [ <ebnf-repeat0> ] "*" syntax grouped ;\r
 274 \r
 275 : 'repeat1' ( -- parser )\r
 276   [ <ebnf-repeat1> ] "+" syntax grouped ;\r
 277 \r
 278 : 'optional' ( -- parser )\r
 279   [ <ebnf-optional> ] "?" syntax grouped ;\r
 280 \r
 281 : 'factor-code' ( -- parser )\r
 282   [\r
 283     "]]" token ensure-not ,\r
 284     "]?" token ensure-not ,\r
 285     [ drop t ] satisfy ,\r
 286   ] seq* repeat0 [ "" concat-as ] action ;\r
 287 \r
 288 : 'ensure-not' ( -- parser )\r
 289   #! Parses the '!' syntax to ensure that \r
 290   #! something that matches the following elements do\r
 291   #! not exist in the parse stream.\r
 292   [\r
 293     "!" syntax ,\r
 294     'group' sp ,\r
 295   ] seq* [ first <ebnf-ensure-not> ] action ;\r
 296 \r
 297 : 'ensure' ( -- parser )\r
 298   #! Parses the '&' syntax to ensure that \r
 299   #! something that matches the following elements does\r
 300   #! exist in the parse stream.\r
 301   [\r
 302     "&" syntax ,\r
 303     'group' sp ,\r
 304   ] seq* [ first <ebnf-ensure> ] action ;\r
 305 \r
 306 : ('sequence') ( -- parser )\r
 307   #! A sequence of terminals and non-terminals, including\r
 308   #! groupings of those. \r
 309   [\r
 310     [ \r
 311       'ensure-not' sp ,\r
 312       'ensure' sp ,\r
 313       'element' sp ,\r
 314       'group' sp , \r
 315       'ignore' sp ,\r
 316       'repeat0' sp ,\r
 317       'repeat1' sp ,\r
 318       'optional' sp , \r
 319     ] choice* \r
 320     [ dup  , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,\r
 321     ,\r
 322   ] choice* ;\r
 323 \r
 324 : 'action' ( -- parser )\r
 325    "[[" 'factor-code' "]]" syntax-pack ;\r
 326 \r
 327 : 'semantic' ( -- parser )\r
 328    "?[" 'factor-code' "]?" syntax-pack ;\r
 329 \r
 330 : 'sequence' ( -- parser )\r
 331   #! A sequence of terminals and non-terminals, including\r
 332   #! groupings of those. \r
 333   [\r
 334     [ ('sequence') , 'action' , ] seq* [ first2 <ebnf-action> ] action ,\r
 335     [ ('sequence') , 'semantic' , ] seq* [ first2 <ebnf-semantic> ] action ,\r
 336     ('sequence') ,\r
 337   ] choice* repeat1 [ \r
 338      dup length 1 = [ first ] [ <ebnf-sequence> ] if\r
 339   ] action ;\r
 340 \r
 341 : 'actioned-sequence' ( -- parser )\r
 342   [\r
 343     [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 <ebnf-action> ] action ,\r
 344     'sequence' ,\r
 345   ] choice* ;\r
 346   \r
 347 : 'choice' ( -- parser )\r
 348   'actioned-sequence' sp repeat1 [ dup length 1 = [ first ] [ <ebnf-sequence> ] if  ] action "|" token sp list-of [ \r
 349     dup length 1 = [ first ] [ <ebnf-choice> ] if\r
 350   ] action ;\r
 351  \r
 352 : 'tokenizer' ( -- parser )\r
 353   [\r
 354     "tokenizer" syntax ,\r
 355     "=" syntax ,\r
 356     ">" token ensure-not ,\r
 357     [ "default" token sp , 'choice' , ] choice* ,\r
 358   ] seq* [ first <ebnf-tokenizer> ] action ;\r
 359 \r
 360 : 'rule' ( -- parser )\r
 361   [\r
 362     "tokenizer" token ensure-not , \r
 363     'non-terminal' [ symbol>> ] action  ,\r
 364     "=" syntax  ,\r
 365     ">" token ensure-not ,\r
 366     'choice' ,\r
 367   ] seq* [ first2 <ebnf-rule> ] action ;\r
 368 \r
 369 : 'ebnf' ( -- parser )\r
 370   [ 'tokenizer' sp , 'rule' sp , ] choice* repeat1 [ <ebnf> ] action ;\r
 371 \r
 372 GENERIC: (transform) ( ast -- parser )\r
 373 \r
 374 SYMBOL: parser\r
 375 SYMBOL: main\r
 376 SYMBOL: ignore-ws\r
 377 \r
 378 : transform ( ast -- object )\r
 379   H{ } clone dup dup [ \r
 380     f ignore-ws set \r
 381     parser set \r
 382     swap (transform) \r
 383     main set \r
 384   ] with-variables ;\r
 385 \r
 386 M: ebnf (transform) ( ast -- parser )\r
 387   rules>> [ (transform) ] map last ;\r
 388 \r
 389 M: ebnf-tokenizer (transform) ( ast -- parser )\r
 390   elements>> dup "default" = [\r
 391     drop default-tokenizer \ tokenizer set-global any-char\r
 392   ] [\r
 393   (transform) \r
 394   dup parser-tokenizer \ tokenizer set-global\r
 395   ] if ;\r
 396 \r
 397 ERROR: redefined-rule name ;\r
 398 \r
 399 M: redefined-rule summary\r
 400   name>> "Rule '" "' defined more than once" surround ;\r
 401   \r
 402 M: ebnf-rule (transform) ( ast -- parser )\r
 403   dup elements>> \r
 404   (transform) [\r
 405     swap symbol>> dup get parser? [ redefined-rule ] [ set ] if\r
 406   ] keep ;\r
 407 \r
 408 M: ebnf-sequence (transform) ( ast -- parser )\r
 409   #! If ignore-ws is set then each element of the sequence\r
 410   #! ignores leading whitespace. This is not inherited by\r
 411   #! subelements of the sequence.\r
 412   elements>> [ \r
 413     f ignore-ws [ (transform) ] with-variable\r
 414     ignore-ws get [ sp ] when\r
 415   ] map seq [ dup length 1 = [ first ] when ] action ;\r
 416 \r
 417 M: ebnf-choice (transform) ( ast -- parser )\r
 418   options>> [ (transform) ] map choice ;\r
 419 \r
 420 M: ebnf-any-character (transform) ( ast -- parser )\r
 421   drop tokenizer any>> call( -- parser ) ;\r
 422 \r
 423 M: ebnf-range (transform) ( ast -- parser )\r
 424   pattern>> range-pattern ;\r
 425 \r
 426 : transform-group ( ast -- parser ) \r
 427   #! convert a ast node with groups to a parser for that group\r
 428   group>> (transform) ;\r
 429 \r
 430 M: ebnf-ensure (transform) ( ast -- parser )\r
 431   transform-group ensure ;\r
 432 \r
 433 M: ebnf-ensure-not (transform) ( ast -- parser )\r
 434   transform-group ensure-not ;\r
 435 \r
 436 M: ebnf-ignore (transform) ( ast -- parser )\r
 437   transform-group [ drop ignore ] action ;\r
 438 \r
 439 M: ebnf-repeat0 (transform) ( ast -- parser )\r
 440   transform-group repeat0 ;\r
 441 \r
 442 M: ebnf-repeat1 (transform) ( ast -- parser )\r
 443   transform-group repeat1 ;\r
 444 \r
 445 M: ebnf-optional (transform) ( ast -- parser )\r
 446   transform-group optional ;\r
 447 \r
 448 M: ebnf-whitespace (transform) ( ast -- parser )\r
 449   t ignore-ws [ transform-group ] with-variable ;\r
 450 \r
 451 GENERIC: build-locals ( code ast -- code )\r
 452 \r
 453 M: ebnf-sequence build-locals ( code ast -- code )\r
 454   #! Note the need to filter out this ebnf items that\r
 455   #! leave nothing in the AST\r
 456   elements>> filter-hidden dup length 1 = [ \r
 457     first build-locals \r
 458   ]  [\r
 459     dup [ ebnf-var? ] filter empty? [\r
 460       drop \r
 461     ] [ \r
 462       [\r
 463         "FROM: locals => [let :> ; FROM: sequences => nth ; FROM: kernel => nip over ; [let " %\r
 464           [\r
 465             over ebnf-var? [\r
 466               " " % # " over nth :> " %\r
 467               name>> % \r
 468             ] [\r
 469               2drop\r
 470             ] if\r
 471           ] each-index\r
 472           " " %\r
 473           %  \r
 474           " nip ]" %     \r
 475       ] "" make \r
 476     ] if\r
 477   ] if ;\r
 478 \r
 479 M: ebnf-var build-locals ( code ast -- code )\r
 480   [\r
 481     "FROM: locals => [let :> ; FROM: kernel => dup nip ; [let " %\r
 482     " dup :> " % name>> %\r
 483     " " %\r
 484     %  \r
 485     " nip ]" %     \r
 486   ] "" make ;\r
 487 \r
 488 M: object build-locals ( code ast -- code )\r
 489   drop ;\r
 490 \r
 491 ERROR: bad-effect quot effect ;\r
 492 \r
 493 : check-action-effect ( quot -- quot )\r
 494   dup infer {\r
 495     { [ dup ( a -- b ) effect<= ] [ drop ] }\r
 496     { [ dup ( -- b ) effect<= ] [ drop [ drop ] prepose ] }\r
 497     [ bad-effect ]\r
 498   } cond ;\r
 499 \r
 500 : ebnf-transform ( ast -- parser quot )\r
 501   [ parser>> (transform) ]\r
 502   [ code>> insert-escapes ]\r
 503   [ parser>> ] tri build-locals  \r
 504   [ string-lines parse-lines ] call( string -- quot ) ;\r
 505  \r
 506 M: ebnf-action (transform) ( ast -- parser )\r
 507   ebnf-transform check-action-effect action ;\r
 508 \r
 509 M: ebnf-semantic (transform) ( ast -- parser )\r
 510   ebnf-transform semantic ;\r
 511 \r
 512 M: ebnf-var (transform) ( ast -- parser )\r
 513   parser>> (transform) ;\r
 514 \r
 515 M: ebnf-terminal (transform) ( ast -- parser )\r
 516   symbol>> tokenizer one>> call( symbol -- parser ) ;\r
 517 \r
 518 ERROR: ebnf-foreign-not-found name ;\r
 519 \r
 520 M: ebnf-foreign-not-found summary\r
 521   name>> "Foreign word '" "' not found" surround ;\r
 522 \r
 523 M: ebnf-foreign (transform) ( ast -- parser )\r
 524   dup word>> search [ word>> ebnf-foreign-not-found ] unless*\r
 525   swap rule>> [ main ] unless* over rule [\r
 526     nip\r
 527   ] [\r
 528     execute( -- parser )\r
 529   ] if* ;\r
 530 \r
 531 ERROR: parser-not-found name ;\r
 532 \r
 533 M: ebnf-non-terminal (transform) ( ast -- parser )\r
 534   symbol>>  [\r
 535     , \ dup , parser get , \ at , [ parser-not-found ] , \ unless* , \ nip ,    \r
 536   ] [ ] make box ;\r
 537 \r
 538 : transform-ebnf ( string -- object )\r
 539   'ebnf' parse transform ;\r
 540 \r
 541 : check-parse-result ( result -- result )\r
 542   [\r
 543     dup remaining>> [ blank? ] trim [\r
 544       [ \r
 545         "Unable to fully parse EBNF. Left to parse was: " %\r
 546         % \r
 547       ] "" make throw\r
 548     ] unless-empty\r
 549   ] [\r
 550     "Could not parse EBNF" throw\r
 551   ] if* ;\r
 552 \r
 553 : parse-ebnf ( string -- hashtable )\r
 554   'ebnf' (parse) check-parse-result ast>> transform ;\r
 555 \r
 556 : ebnf>quot ( string -- hashtable quot )\r
 557   parse-ebnf dup dup parser [ main swap at compile ] with-variable\r
 558   [ compiled-parse ] curry [ with-scope ast>> ] curry ;\r
 559 \r
 560 PRIVATE>\r
 561 \r
 562 SYNTAX: <EBNF\r
 563   "EBNF>"\r
 564   reset-tokenizer parse-multiline-string parse-ebnf main swap at  \r
 565   suffix! reset-tokenizer ;\r
 566 \r
 567 SYNTAX: [EBNF\r
 568   "EBNF]"\r
 569   reset-tokenizer parse-multiline-string ebnf>quot nip \r
 570   suffix! \ call suffix! reset-tokenizer ;\r
 571 \r
 572 SYNTAX: EBNF: \r
 573   reset-tokenizer scan-new-word dup ";EBNF" parse-multiline-string  \r
 574   ebnf>quot swapd\r
 575   ( input -- ast ) define-declared "ebnf-parser" set-word-prop \r
 576   reset-tokenizer ;\r