1# peg_to_param.tcl -- 2# 3# Conversion of PEG to PARAM assembler. 4# 5# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net> 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: pt_peg_to_param.tcl,v 1.1 2010/03/26 05:07:24 andreas_kupries Exp $ 11 12# This package takes the canonical serialization of a parsing 13# expression grammar and produces text in PARAM assembler, i.e. 14# readable machine code for the PARAM virtual machine. 15 16## NOTE: Should have cheat sheet of PARAM instructions (which parts of 17## the arch state they touch, and secondly, bigger effects). 18 19# ### ### ### ######### ######### ######### 20## Requisites 21 22package require Tcl 8.5 23package require pt::peg ; # Verification that the input 24 # is proper. 25package require pt::pe ; # Walking an expression. 26package require text::write ; # Text generation support 27package require char 28 29# ### ### ### ######### ######### ######### 30## 31 32namespace eval ::pt::peg::to::param { 33 namespace export \ 34 reset configure convert 35 36 namespace ensemble create 37} 38 39# ### ### ### ######### ######### ######### 40## API. 41 42proc ::pt::peg::to::param::reset {} { 43 variable template @code@ 44 variable name a_pe_grammar 45 variable file unknown 46 variable user unknown 47 variable inline 1 48 variable compact 1 49 return 50} 51 52proc ::pt::peg::to::param::configure {args} { 53 variable template 54 variable name 55 variable file 56 variable user 57 variable inline 58 variable compact 59 60 if {[llength $args] == 0} { 61 return [list \ 62 -inline $inline \ 63 -compact $compact \ 64 -file $file \ 65 -name $name \ 66 -template $template \ 67 -user $user] 68 } elseif {[llength $args] == 1} { 69 lassign $args option 70 set variable [string range $option 1 end] 71 if {[info exists $variable]} { 72 return [set $variable] 73 } else { 74 return -code error "Expected one of -compact, -file, -inline, -name, -template, or -user, got \"$option\"" 75 } 76 } elseif {[llength $args] % 2 == 0} { 77 foreach {option value} $args { 78 set variable [string range $option 1 end] 79 if {![info exists $variable]} { 80 return -code error "Expected one of -compact, -file, -inline, -name, -template, or -user, got \"$option\"" 81 } 82 } 83 foreach {option value} $args { 84 set variable [string range $option 1 end] 85 switch -exact -- $variable { 86 template { 87 if {$value eq {}} { 88 return -code error "Expected template, got the empty string" 89 } 90 } 91 inline - compact { 92 if {![::string is boolean -strict $value]} { 93 return -code error "Expected boolean, got \"$value\"" 94 } 95 } 96 name - 97 file - 98 user { } 99 } 100 set $variable $value 101 } 102 } else { 103 return -code error {wrong#args, expected option value ...} 104 } 105} 106 107proc ::pt::peg::to::param::convert {serial} { 108 variable template 109 variable name 110 variable file 111 variable user 112 113 Op::Asm::Setup 114 115 ::pt::peg verify-as-canonical $serial 116 117 # Unpack the serialization, known as canonical 118 array set peg $serial 119 array set peg $peg(pt::grammar::peg) 120 unset peg(pt::grammar::peg) 121 122 set modes {} 123 foreach {symbol def} $peg(rules) { 124 lassign $def _ is _ mode 125 lappend modes $symbol $mode 126 } 127 128 text::write reset 129 set blocks {} 130 131 # Translate all expressions/symbols, results are stored in 132 # text::write blocks, command results are the block ids. 133 lappend blocks [set start [Expression $peg(start) $modes]] 134 135 foreach {symbol def} $peg(rules) { 136 lassign $def _ is _ mode 137 lappend blocks [Symbol $symbol $mode $is $modes] 138 } 139 140 # Assemble the output from the stored blocks. 141 text::write clear 142 Op::Asm::Header {Grammar Start Expression} 143 Op::Asm::Label <<MAIN>> 144 Op::Asm::Call $start 0 145 Op::Asm::Ins halt 146 text::write /line 147 148 Op::Asm::Use {*}$blocks 149 150 # At last retrieve the fully assembled result and integrate with 151 # the chosen template. 152 153 return [string map \ 154 [list \ 155 @user@ $user \ 156 @format@ PEG \ 157 @file@ $file \ 158 @name@ $name \ 159 @code@ [text::write get]] $template] 160 161 # ### ### ### ######### ######### ######### 162} 163 164# ### ### ### ######### ######### ######### 165## Internals 166 167proc ::pt::peg::to::param::Expression {expression modes} { 168 return [pt::pe bottomup \ 169 [list [namespace current]::Op $modes] \ 170 $expression] 171} 172 173proc ::pt::peg::to::param::Symbol {symbol mode rhs modes} { 174 175 set expression [Expression $rhs $modes] 176 177 text::write clear 178 Op::Asm::Header "$mode Symbol '$symbol'" 179 text::write store FUN_HEADER 180 181 Op::Asm::Start 182 Op::Asm::ReExpression $symbol 183 Op::Asm::GenAST $expression 184 Op::Asm::PE $rhs 185 186 set gen [dict get $result gen] 187 188 Op::Asm::Function sym_$symbol { 189 190 # We have six possibilites for the combination of AST node 191 # generation by the rhs and AST generation by the symbol. Two 192 # of these (leaf/0, value/0 coincide, leaving 5). This 193 # controls the use of AS/ARS instructions. 194 195 switch -exact -- $mode/$gen { 196 value/1 { 197 # Generate value for symbol, rhs may have generated 198 # AST nodes as well, keep rhs 199 200 set found [Op::Asm::NewLabel found] 201 202 Op::Asm::Ins symbol_restore $symbol 203 Op::Asm::Ins found! jump $found 204 205 Op::Asm::Ins loc_push 206 Op::Asm::Ins ast_push 207 208 Op::Asm::Call $expression 209 210 Op::Asm::Ins fail! value_clear 211 Op::Asm::Ins ok! value_reduce $symbol 212 213 Op::Asm::Ins symbol_save $symbol 214 Op::Asm::Ins error_nonterminal $symbol 215 216 Op::Asm::Ins ast_pop_rewind 217 Op::Asm::Ins loc_pop_discard 218 219 Op::Asm::Label $found 220 Op::Asm::Ins ok! ast_value_push 221 } 222 leaf/0 - 223 value/0 { 224 # Generate value for symbol, rhs cannot generate its 225 # own AST nodes => leaf/0. 226 227 set found [Op::Asm::NewLabel found] 228 229 Op::Asm::Ins symbol_restore $symbol 230 Op::Asm::Ins found! jump $found 231 232 Op::Asm::Ins loc_push 233 234 Op::Asm::Call $expression 235 236 Op::Asm::Ins fail! value_clear 237 Op::Asm::Ins ok! value_leaf $symbol 238 239 Op::Asm::Ins symbol_save $symbol 240 Op::Asm::Ins error_nonterminal $symbol 241 242 Op::Asm::Ins loc_pop_discard 243 244 Op::Asm::Label $found 245 Op::Asm::Ins ok! ast_value_push 246 } 247 leaf/1 { 248 # Generate value for symbol, rhs may have generated 249 # AST nodes as well, discard rhs. 250 251 set found [Op::Asm::NewLabel found] 252 253 Op::Asm::Ins symbol_restore $symbol 254 Op::Asm::Ins found! jump $found 255 256 Op::Asm::Ins loc_push 257 Op::Asm::Ins ast_push 258 259 Op::Asm::Call $expression 260 261 Op::Asm::Ins fail! value_clear 262 Op::Asm::Ins ok! value_leaf $symbol 263 264 Op::Asm::Ins symbol_save $symbol 265 Op::Asm::Ins error_nonterminal $symbol 266 267 Op::Asm::Ins ast_pop_rewind 268 Op::Asm::Ins loc_pop_discard 269 270 Op::Asm::Label $found 271 Op::Asm::Ins ok! ast_value_push 272 } 273 void/1 { 274 # Generate no value for symbol, rhs may have generated 275 # AST nodes as well, discard rhs. 276 277 Op::Asm::Ins symbol_restore $symbol ; # Implied 278 Op::Asm::Ins found! return 279 280 Op::Asm::Ins loc_push 281 Op::Asm::Ins ast_push 282 283 Op::Asm::Call $expression 284 285 Op::Asm::Ins value_clear 286 287 Op::Asm::Ins symbol_save $symbol 288 Op::Asm::Ins error_nonterminal $symbol 289 290 Op::Asm::Ins ast_pop_rewind 291 Op::Asm::Ins loc_pop_discard 292 } 293 void/0 { 294 # Generate no value for symbol, rhs cannot generate 295 # its own AST nodes. Nothing to save nor discard. 296 297 Op::Asm::Ins symbol_restore $symbol ; # Implied 298 Op::Asm::Ins found! return 299 300 Op::Asm::Ins loc_push 301 302 Op::Asm::Call $expression 303 304 Op::Asm::Ins value_clear 305 306 Op::Asm::Ins symbol_save $symbol 307 Op::Asm::Ins error_nonterminal $symbol 308 309 Op::Asm::Ins loc_pop_discard 310 } 311 } 312 } $expression 313 Op::Asm::Done 314} 315 316namespace eval ::pt::peg::to::param::Op { 317 namespace export \ 318 alpha alnum ascii digit graph lower print \ 319 punct space upper wordchar xdigit ddigit \ 320 dot epsilon t .. n ? * + & ! x / 321} 322 323proc ::pt::peg::to::param::Op {modes pe op arguments} { 324 return [namespace eval Op [list $op $modes {*}$arguments]] 325} 326 327proc ::pt::peg::to::param::Op::epsilon {modes} { 328 Asm::Start 329 Asm::ReExpression epsilon 330 Asm::Direct { 331 Asm::Ins status_ok 332 } 333 Asm::Done 334} 335 336proc ::pt::peg::to::param::Op::dot {modes} { 337 Asm::Start 338 Asm::ReExpression dot 339 Asm::Direct { 340 Asm::Ins input_next \"dot\" 341 } 342 Asm::Done 343} 344 345foreach test { 346 alpha alnum ascii digit graph lower print 347 punct space upper wordchar xdigit ddigit 348} { 349 proc ::pt::peg::to::param::Op::$test {modes} \ 350 [string map [list @ $test] { 351 variable ::pt::peg::to::param::inline 352 Asm::Start 353 Asm::ReExpression @ 354 if {$inline} { 355 Asm::Direct { 356 Asm::Ins input_next \"@\" 357 Asm::Ins ok! test_@ 358 } 359 } else { 360 Asm::Function [Asm::NewBlock @] { 361 Asm::Ins input_next \"@\" 362 Asm::Ins ok! test_@ 363 } 364 } 365 Asm::Done 366 }] 367} 368 369proc ::pt::peg::to::param::Op::t {modes char} { 370 variable ::pt::peg::to::param::inline 371 Asm::Start 372 Asm::ReTerminal t $char 373 if {$inline} { 374 Asm::Direct { 375 set c [char quote cstring $char] 376 377 Asm::Ins input_next "\"t $c\"" 378 Asm::Ins ok! test_char \"$c\" 379 } 380 } else { 381 Asm::Function [Asm::NewBlock char ] { 382 set c [char quote cstring $char] 383 384 Asm::Ins input_next "\"t $c\"" 385 Asm::Ins ok! test_char \"$c\" 386 } 387 } 388 Asm::Done 389} 390 391proc ::pt::peg::to::param::Op::.. {modes chstart chend} { 392 variable ::pt::peg::to::param::inline 393 Asm::Start 394 Asm::ReTerminal .. $chstart $chend 395 if {$inline} { 396 Asm::Direct { 397 set s [char quote cstring $chstart] 398 set e [char quote cstring $chend] 399 400 Asm::Ins input_next "\".. $s $e\"" 401 Asm::Ins ok! test_range \"$s\" \"$e\" 402 } 403 } else { 404 Asm::Function [Asm::NewBlock range] { 405 set s [char quote cstring $chstart] 406 set e [char quote cstring $chend] 407 408 Asm::Ins input_next "\".. $s $e\"" 409 Asm::Ins ok! test_range \"$s\" \"$e\" 410 } 411 } 412 Asm::Done 413} 414 415proc ::pt::peg::to::param::Op::n {modes symbol} { 416 # symbol mode determines AST generation 417 # void => non-generative, 418 # leaf/value => generative. 419 420 Asm::Start 421 Asm::ReTerminal n $symbol 422 423 if {![dict exists $modes $symbol]} { 424 # Incomplete grammar. The symbol has no definition. 425 Asm::Direct { 426 Asm::Ins status_fail {} "; # Undefined symbol '$symbol'" 427 } 428 } else { 429 Asm::GenAST [list gen [expr { [dict get $modes $symbol] ne "void" }]] 430 Asm::Direct { 431 Asm::Ins call sym_$symbol 432 } 433 } 434 Asm::Done 435} 436 437proc ::pt::peg::to::param::Op::& {modes expression} { 438 # Note: This operation could be inlined, as it has no special 439 # control flow. Not done to make the higher-level ops are 440 # similar in construction and use = consistent and simple. 441 442 Asm::Start 443 Asm::ReExpression & $expression 444 Asm::GenAST $expression 445 446 Asm::Function [Asm::NewBlock ahead] { 447 Asm::Ins loc_push 448 Asm::Call $expression 449 Asm::Ins loc_pop_rewind 450 } $expression 451 Asm::Done 452} 453 454proc ::pt::peg::to::param::Op::! {modes expression} { 455 # Note: This operation could be inlined, as it has no special 456 # control flow. Not done to make the higher-level ops are 457 # similar in construction and use = consistent and simple. 458 459 Asm::Start 460 Asm::ReExpression ! $expression 461 if {[dict get $expression gen]} { 462 Asm::Function [Asm::NewBlock notahead] { 463 # The sub-expression may generate AST elements. We must 464 # not pass them through. 465 466 Asm::Ins loc_push 467 Asm::Ins ast_push 468 469 Asm::Call $expression 470 471 Asm::Ins fail! ast_pop_discard 472 Asm::Ins ok! ast_pop_rewind 473 Asm::Ins loc_pop_rewind 474 Asm::Ins status_negate 475 } $expression 476 } else { 477 Asm::Function [Asm::NewBlock notahead] { 478 # The sub-expression cannot generate AST elements. We can 479 # ignore AS/ARS, simplifying the code. 480 481 Asm::Ins loc_push 482 483 Asm::Call $expression 484 485 Asm::Ins loc_pop_rewind 486 Asm::Ins status_negate 487 } $expression 488 } 489 Asm::Done 490} 491 492proc ::pt::peg::to::param::Op::? {modes expression} { 493 # Note: This operation could be inlined, as it has no special 494 # control flow. Not done to make the higher-level ops are 495 # similar in construction and use => consistent and simple. 496 497 Asm::Start 498 Asm::ReExpression ? $expression 499 Asm::GenAST $expression 500 501 Asm::Function [Asm::NewBlock optional] { 502 Asm::Ins loc_push 503 Asm::Ins error_push 504 505 Asm::Call $expression 506 507 Asm::Ins error_pop_merge 508 Asm::Ins fail! loc_pop_rewind 509 Asm::Ins ok! loc_pop_discard 510 Asm::Ins status_ok 511 } $expression 512 Asm::Done 513} 514 515proc ::pt::peg::to::param::Op::* {modes expression} { 516 Asm::Start 517 Asm::ReExpression * $expression 518 Asm::GenAST $expression 519 520 Asm::Function [Asm::NewBlock kleene] { 521 set failed [Asm::NewLabel failed] 522 523 Asm::Ins loc_push 524 Asm::Ins error_push 525 526 Asm::Call $expression 527 528 Asm::Ins error_pop_merge 529 Asm::Ins fail! jump $failed 530 Asm::Ins loc_pop_discard 531 Asm::Ins jump [Asm::LastId] ; # Loop head = Function head. 532 533 # FAILED, clean up and return OK. 534 Asm::Label $failed 535 Asm::Ins loc_pop_rewind 536 Asm::Ins status_ok 537 } $expression 538 Asm::Done 539} 540 541proc ::pt::peg::to::param::Op::+ {modes expression} { 542 Asm::Start 543 Asm::ReExpression + $expression 544 Asm::GenAST $expression 545 546 Asm::Function [Asm::NewBlock poskleene] { 547 set failed [Asm::NewLabel failed] 548 set loophead [Asm::NewLabel loop] 549 550 Asm::Ins loc_push 551 552 Asm::Call $expression 553 554 # FAILED truly. 555 Asm::Ins fail! jump $failed 556 557 Asm::Label $loophead 558 Asm::Ins loc_pop_discard 559 Asm::Ins loc_push 560 Asm::Ins error_push 561 562 Asm::Call $expression 563 564 Asm::Ins error_pop_merge 565 Asm::Ins ok! jump $loophead 566 # FAILED, clean up and return OK. 567 Asm::Ins status_ok 568 569 Asm::Label $failed 570 Asm::Ins loc_pop_rewind 571 } $expression 572 Asm::Done 573} 574 575proc ::pt::peg::to::param::Op::x {modes args} { 576 if {[llength $args] == 1} { 577 return [lindex $args 0] 578 } 579 580 Asm::Start 581 Asm::ReExpression x {*}$args 582 set gens [Asm::GenAST {*}$args] 583 584 # We have three possibilities regarding AST node generation, each 585 # requiring a slightly different instruction sequence. 586 587 # i. gen == 0 <=> No node generation at all. 588 # ii. gens[0] == 1 <=> We may have nodes from the beginning. 589 # iii. <=> Node generation starts in the middle. 590 591 if {![dict get $result gen]} { 592 set mode none 593 } elseif {[lindex $gens 0]} { 594 set mode all 595 } else { 596 set mode some 597 } 598 599 Asm::Function [Asm::NewBlock sequence] { 600 601 set failed [Asm::NewLabel failed] 602 if {$mode eq "some"} { 603 set failed_noast [Asm::NewLabel failednoast] 604 } 605 606 switch -exact -- $mode { 607 none { 608 # (Ad i) No AST node generation at all. 609 610 Asm::Ins loc_push 611 Asm::Ins error_clear 612 text::write /line 613 614 # Note: This loop runs at code generation time. At 615 # runtime the entire construction is essentially a 616 # fully unrolled loop, with each iteration having its 617 # own block of instructions. 618 619 foreach expression $args { 620 Asm::Ins error_push 621 622 Asm::Call $expression 623 624 Asm::Ins error_pop_merge 625 # Stop the sequence on element failure 626 Asm::Ins fail! jump $failed 627 } 628 629 # All elements OK, squash backtracking state 630 text::write /line 631 Asm::Ins loc_pop_discard 632 Asm::Ins return 633 634 # An element failed, restore state to before we tried 635 # the sequence. 636 Asm::Label $failed 637 Asm::Ins loc_pop_rewind 638 } 639 all { 640 # (Ad ii) AST node generation from start to end. 641 642 Asm::Ins ast_push 643 Asm::Ins loc_push 644 Asm::Ins error_clear 645 text::write /line 646 647 # Note: This loop runs at code generation time. At 648 # runtime the entire construction is essentially a 649 # fully unrolled loop, with each iteration having its 650 # own block of instructions. 651 652 foreach expression $args { 653 Asm::Ins error_push 654 655 Asm::Call $expression 656 657 Asm::Ins error_pop_merge 658 # Stop the sequence on element failure 659 Asm::Ins fail! jump $failed 660 } 661 662 # All elements OK, squash backtracking state 663 text::write /line 664 Asm::Ins ast_pop_discard 665 Asm::Ins loc_pop_discard 666 Asm::Ins return 667 668 # An element failed, restore state to before we tried 669 # the sequence. 670 Asm::Label $failed 671 Asm::Ins ast_pop_rewind 672 Asm::Ins loc_pop_rewind 673 } 674 some { 675 # (Ad iii). Start without AST nodes, later parts do 676 # AST nodes. 677 678 Asm::Ins loc_push 679 Asm::Ins error_clear 680 text::write /line 681 682 # Note: This loop runs at code generation time. At 683 # runtime the entire construction is essentially a 684 # fully unrolled loop, with each iteration having its 685 # own block of instructions. 686 687 set pushed 0 688 foreach expression $args xgen $gens { 689 if {!$pushed && $xgen} { 690 Asm::Ins ast_push 691 set pushed 1 692 } 693 694 Asm::Ins error_push 695 696 Asm::Call $expression 697 698 Asm::Ins error_pop_merge 699 # Stop the sequence on element failure 700 if {$pushed} { 701 Asm::Ins fail! jump $failed 702 } else { 703 Asm::Ins fail! jump $failed_noast 704 } 705 } 706 707 # All elements OK, squash backtracking state. 708 text::write /line 709 Asm::Ins ast_pop_discard 710 Asm::Ins loc_pop_discard 711 Asm::Ins return 712 713 # An element failed, restore state to before we tried 714 # the sequence. 715 Asm::Label $failed 716 Asm::Ins ast_pop_rewind 717 Asm::Label $failed_noast 718 Asm::Ins loc_pop_rewind 719 } 720 } 721 } {*}$args 722 Asm::Done 723} 724 725proc ::pt::peg::to::param::Op::/ {modes args} { 726 if {[llength $args] == 1} { 727 return [lindex $args 0] 728 } 729 730 Asm::Start 731 Asm::ReExpression / {*}$args 732 set gens [Asm::GenAST {*}$args] 733 734 if {![dict get $result genmin]} { 735 # We have at least one branch without AST node generation. 736 set ok_noast [Asm::NewLabel oknoast] 737 } else { 738 set ok_noast {} 739 } 740 if {[dict get $result gen]} { 741 # We have at least one branch capable of generating AST nodes. 742 set ok [Asm::NewLabel ok] 743 } else { 744 set ok {} 745 } 746 747 # Optimized AST handling: Handle each branch separately, based on 748 # its ability to generate AST nodes. 749 750 Asm::Function [Asm::NewBlock choice] { 751 Asm::Ins error_clear 752 text::write /line 753 754 # Note: This loop runs at code generation time. At runtime the 755 # entire construction is seentially a fully unrolled loop, 756 # with each iteration having its own block of instructions. 757 758 foreach expression $args xgen $gens { 759 if {$xgen} { 760 Asm::Ins ast_push 761 } 762 Asm::Ins loc_push 763 Asm::Ins error_push 764 765 Asm::Call $expression 766 767 Asm::Ins error_pop_merge 768 if {$xgen} { 769 Asm::Ins ok! jump $ok 770 } else { 771 Asm::Ins ok! jump $ok_noast 772 } 773 text::write /line 774 if {$xgen} { 775 Asm::Ins ast_pop_rewind 776 } 777 Asm::Ins loc_pop_rewind 778 } 779 780 # All branches FAILED 781 Asm::Ins status_fail 782 Asm::Ins return 783 784 # A branch was successful, squash the backtracking state 785 if {$ok ne {}} { 786 Asm::Label $ok 787 Asm::Ins ast_pop_discard 788 } 789 if {$ok_noast ne {}} { 790 Asm::Label $ok_noast 791 } 792 Asm::Ins loc_pop_discard 793 } {*}$args 794 Asm::Done 795} 796 797# ### ### ### ######### ######### ######### 798## Allocate a text block / internal symbol / function 799 800namespace eval ::pt::peg::to::param::Op::Asm {} 801 802proc ::pt::peg::to::param::Op::Asm::Start {} { 803 upvar 1 result result 804 set result {def {} use {} gen 0 pe {}} 805 return 806} 807 808proc ::pt::peg::to::param::Op::Asm::Done {} { 809 upvar 1 result result 810 return -code return $result 811 return 812} 813 814proc ::pt::peg::to::param::Op::Asm::ReExpression {op args} { 815 upvar 1 result result 816 817 set pe $op 818 foreach a $args { 819 lappend pe [dict get $a pe] 820 } 821 822 dict set result pe $pe 823 PE $pe 824 return 825} 826 827proc ::pt::peg::to::param::Op::Asm::ReTerminal {op args} { 828 upvar 1 result result 829 830 set pe [linsert $args 0 $op] 831 dict set result pe $pe 832 PE $pe 833 return 834} 835 836proc ::pt::peg::to::param::Op::Asm::GenAST {args} { 837 upvar 1 result result 838 839 foreach a $args { 840 lappend flags [dict get $a gen] 841 } 842 843 dict set result gen [tcl::mathfunc::max {*}$flags] 844 dict set result genmin [tcl::mathfunc::min {*}$flags] 845 return $flags 846} 847 848proc ::pt::peg::to::param::Op::Asm::NewBlock {type} { 849 variable counter 850 variable lastid ${type}_[incr counter] 851 return $lastid 852} 853 854proc ::pt::peg::to::param::Op::Asm::NewLabel {{prefix {label}}} { 855 variable counter 856 return ${prefix}_[incr counter] 857} 858 859proc ::pt::peg::to::param::Op::Asm::Function {name def args} { 860 upvar 1 result result 861 variable ::pt::peg::to::param::compact 862 variable cache 863 864 set k [list [dict get $result gen] [dict get $result pe]] 865 866#puts $name///<<$k>>==[info exists cache($k)]\t\t($result) 867 868 if {$compact && [info exists cache($k)]} { 869 dict set result def {} 870 dict set result use $cache($k) 871 return 872 } 873 874 text::write clear 875 if {[text::write exists FUN_HEADER]} { 876 text::write recall FUN_HEADER 877 text::write undef FUN_HEADER 878 } 879 880 Label $name 881 text::write recall PE ; # Generated in Asm::Zip, printed rep 882 text::write undef PE ; # of the expression, for code clarity 883 884 uplevel 1 $def 885 Ins return 886 887 if {[llength $args]} { 888 Use {*}$args 889 } 890 891 text::write store $name 892 893 set useb [NewBlock anon] 894 text::write clear 895 Ins call $name 896 text::write store $useb 897 898 dict set result def $name 899 dict set result use $useb 900 901 set cache($k) $useb 902 return 903} 904 905proc ::pt::peg::to::param::Op::Asm::Direct {use} { 906 upvar 1 result result 907 908 set useb [NewBlock anon] 909 text::write clear 910 uplevel 1 $use 911 text::write store $useb 912 913 dict set result def {} 914 dict set result use $useb 915 return 916} 917 918proc ::pt::peg::to::param::Op::Asm::Call {expr {distance 1}} { 919 if {$distance} { text::write /line } 920 text::write recall [dict get $expr use] 921 if {$distance} { text::write /line } 922 return 923} 924 925proc ::pt::peg::to::param::Op::Asm::Use {args} { 926 foreach item $args { 927 set def [dict get $item def] 928 if {$def eq {}} continue 929 text::write recall $def 930 text::write undef $def 931 } 932 return 933} 934 935proc ::pt::peg::to::param::Op::Asm::Ins {args} { 936 variable fieldlen 937 938 if {[string match *! [lindex $args 0]]} { 939 set args [lassign $args guard] 940 text::write fieldr 8 $guard 941 } else { 942 text::write fieldr 8 {} 943 } 944 foreach w $args len $fieldlen { 945 text::write fieldl $len $w 946 } 947 text::write /line 948 return 949} 950 951proc ::pt::peg::to::param::Op::Asm::Label {label} { 952 text::write /line 953 text::write field ${label}: 954 text::write /line 955 return 956} 957 958proc ::pt::peg::to::param::Op::Asm::LastId {} { 959 variable lastid 960 return $lastid 961} 962 963proc ::pt::peg::to::param::Op::Asm::Header {text} { 964 text::write field "#" 965 text::write /line 966 text::write field "# $text" 967 text::write /line 968 text::write field "#" 969 text::write /line 970 #text::write /line 971 return 972} 973 974proc ::pt::peg::to::param::Op::Asm::PE {pe} { 975 text::write clear 976 text::write field [pt::pe print $pe] 977 text::write /line 978 text::write prefix "# " 979 text::write /line 980 text::write store PE 981 return 982} 983 984proc ::pt::peg::to::param::Op::Asm::Setup {} { 985 variable counter 0 986 variable fieldlen {17 5 5} 987 variable cache 988 array unset cache * 989 return 990} 991 992# ### ### ### ######### ######### ######### 993## Configuration 994 995namespace eval ::pt::peg::to::param { 996 namespace eval ::pt::peg::to::param::Op::Asm { 997 variable counter 0 998 variable fieldlen {17 5 5} 999 variable cache 1000 array set cache {} 1001 } 1002 1003 variable inline 1 ; # A boolean flag. Specifies if we 1004 # should inline terminal tests 1005 # (default), or put them into 1006 # their own functions. 1007 variable compact 1 ; # A boolean flag. Specifies if we 1008 # should try to coalesce 1009 # identical parsing expressions, 1010 # i.e. compile them once 1011 # (default), or not. 1012 variable template @code@ ; # A string. Specifies how to 1013 # embed the generated code into a 1014 # larger frame- work (the 1015 # template). 1016 variable name a_pe_grammar ; # String. Name of the grammar. 1017 variable file unknown ; # String. Name of the file or 1018 # other entity the grammar came 1019 # from. 1020 variable user unknown ; # String. Name of the user on 1021 # which behalf the conversion has 1022 # been invoked. 1023} 1024 1025# ### ### ### ######### ######### ######### 1026## Ready 1027 1028package provide pt::peg::to::param 1 1029return 1030