compilers/pge/demo.pir

   1 .include "errors.pasm"
   2 .sub _main
   3     .local string x
   4     .local string pattern
   5     .local int istraced
   6     .local pmc stdin
   7     .local pmc rulesub
   8     .local pmc pir
   9     .local pmc exp
  10     .local pmc match
  11     .local pmc p6rule_compile
  12     .local pmc p5regexp_compile
  13     .local pmc glob_compile
  14     .local int istrace
  15     .local string gname
  16
  17     errorson .PARROT_ERRORS_PARAM_COUNT_FLAG
  18
  19     load_bytecode "PGE.pbc"
  20     load_bytecode "dumper.pir"
  21     load_bytecode "PGE/Dumper.pir"
  22     load_bytecode "PGE/Glob.pir"
  23     load_bytecode "PGE/Text.pir"
  24     load_bytecode "PGE/Util.pir"
  25     p6rule_compile = compreg "PGE::Perl6Regex"
  26     glob_compile = compreg "PGE::Glob"
  27     p5regexp_compile = compreg "PGE::P5Regex"
  28     istrace = 0
  29     null rulesub
  30
  31   read_loop:
  32     print "\ninput \"regex <pattern>\", \"glob <pattern>\", \"save <name>\",\n"
  33     print "target string, \"pir\", \"exp\", \"trace\", \"next\"\n"
  34     getstdin stdin
  35     readline x, stdin
  36     length $I0, x
  37     if $I0 < 1 goto end_demo
  38     $I0 = index x, " "
  39     if $I0 > 0 goto get_cmd
  40     $I0 = index x, "\n"
  41   get_cmd:
  42     $S0 = substr x, 0, $I0
  43     chopn x, 1
  44     if $S0 == "next" goto match_next
  45     if $S0 == "regex" goto make_p6rule
  46     if $S0 == "glob" goto make_glob
  47     if $S0 == "save" goto save_rule
  48     if $S0 == "pir" goto print_pir
  49     if $S0 == "exp" goto print_exp
  50     if $S0 == "trace" goto toggle_trace
  51     if $S0 == "p5regex" goto make_regexp
  52
  53     if_null rulesub, match_nopattern
  54     match = rulesub(x)
  55   match_result:
  56     unless match goto match_fail
  57     print "match succeeded\n"
  58     $P0 = find_global "_dumper"
  59     $P0(match, "$/")
  60     goto read_loop
  61   match_fail:
  62     print "match failed\n"
  63     goto read_loop
  64   match_nopattern:
  65     print "no pattern entered yet\n"
  66     goto read_loop
  67
  68   match_next:
  69     match."next"()
  70     goto match_result
  71
  72   make_glob:
  73     pattern = substr x, 5
  74     (rulesub) = glob_compile(pattern)
  75     goto read_loop
  76
  77   make_p6rule:
  78     pattern = substr x, 5
  79     (rulesub) = p6rule_compile(pattern)
  80     goto read_loop
  81
  82   make_regexp:
  83     pattern = substr x, 7
  84     (rulesub) = p5regexp_compile(pattern)
  85     goto read_loop
  86
  87   save_rule:
  88     if_null rulesub, match_nopattern
  89     x = substr x, 5
  90     store_global x, rulesub
  91     print "Saved as "
  92     print x
  93     print "\n"
  94     goto read_loop
  95
  96
  97   print_pir:
  98     if_null rulesub, match_nopattern
  99     print pir
 100     goto read_loop
 101
 102   print_exp:
 103     if_null rulesub, match_nopattern
 104     $P0 = find_global "_dumper"
 105     $P0(exp, "exp")
 106     goto read_loop
 107
 108   toggle_trace:
 109     istrace = not istrace
 110     trace istrace
 111     unless istrace goto trace_off
 112     print "Tracing is now on\n"
 113     goto read_loop
 114   trace_off:
 115     print "Tracing is now off\n"
 116     goto read_loop
 117
 118   end_demo:
 119 .end
 120
 121 # Local Variables:
 122 #   mode: pir
 123 #   fill-column: 100
 124 # End:
 125 # vim: expandtab shiftwidth=4 ft=pir: